0

我正在尝试使代码通过包含重复部分内容控件（RepSecCC）的word文档运行，其中包含几个嵌套的CC。我想编写宏，它会为每个 RepSecCC 生成新的 Word 文档（从模板）并用来自嵌套 CC 的信息填充它。

我当前的代码仅生成一个文档并使用上一个 RepSecCC 的信息填充它的问题。我不明白为什么它会跳过所有其他 RepSecCC。我应该在哪里调整我的代码？

    Dim objWord As Object
    Dim objDoc As Object
    Dim pack As String, Reg_No As String, VP_name As String, 
    Dim CC As Word.ContentControl
    Dim rCC As Word.ContentControl

    Set objWord = CreateObject("Word.Application")

    MsgBox "Document's are generated. Please wait"

    For Each rCC In ActiveDocument.ContentControls

        If rCC.Title = "New_section" Then

            For Each CC In rCC.Range.ContentControls
                If CC.Tag = "LI_NO" Then
                    Reg_No = CC.Range.Text
                ElseIf CC.Tag = "VP_pav" Then
                    VP_name = CC.Range.Text
                ElseIf CC.Tag = "Pack" Then
                    pack = CC.Range.Text
                    pack = UCase(Left(pack, 1)) & Mid(pack, 2)
                End If
            Next CC

            Set objDoc = objWord.Documents.Add(Template:="S:\bendri\VRS\VRS Administravimas\6 Lygiagretus importas\LI registracijos sarasas\LI_sablonasM.dotm", NewTemplate:=False, DocumentType:=0)
            objWord.Visible = True

            With objDoc
                .ContentControls.Item(1).Range.Text = Reg_No
                .ContentControls.Item(2).Range.Text = VP_name
                .ContentControls.Item(4).Range.Text = pack
            End With
        End If
    Next rCC

    MsgBox "Finished. Please continue"

End Sub
4

1 回答 1

0

我自己想通了，事实证明，我的初始代码有两个问题：

1）第二个For each...next循环遍历每个CC并调整变量，直到到达最后一个CC并且变量值保持不变。正因为如此，我的文档只收到了最后一部分的信息。

2) 另一个问题是由于某种原因，重复的 CC 部分没有被视为单独的对象，因此，整个重复的 CC 被计为一个，因此只创建了一个文档。

我通过改变整个代码的工作原理设法克服了这些问题：

首先，对于我创建的每个相关 CC，New Collection然后我遍历所有文档并将这些 CC 值添加到适当的集合中。

然后，我再次遍历文档，并为每个带有特定标签的 CC 创建了新文档，该文档从 Collections 中获取值。由于集合中的值是按顺序排列的，我只添加了计数器，它计算循环数，并由此确定要使用集合中的哪个值。

我确信这可能不是最有效的方法，但它可以以令人满意的速度运行。

我的最终代码，也许有人可以使用它：

Public Sub generate_docs()

    Dim objWord As Object
    Dim objDoc As Object
    Dim pack As New Collection, Reg_number As New Collection, VP_name As New Collection, Client As New Collection
    Dim Number As String
    Dim CC As Word.ContentControl
    Dim TagCC As Word.ContentControl
    Dim ccRepSec As Word.ContentControl
    Dim i As Long
    Dim x As String

    i = 0

    Set objWord = CreateObject("Word.Application")
    Set ccRepSec = ActiveDocument.SelectContentControlsByTitle("Nauja registracija").Item(1)

    MsgBox "Documents are being generated. Please wait"

    For Each CC In ccRepSec.Range.ContentControls
        If CC.Tag = "LI_NO" Then
            x = CC.Range.Text
            Reg_number.Add Item:=x
        ElseIf CC.Tag = "VP_pav" Then
            x = CC.Range.Text
            VP_name.Add Item:=x
        ElseIf CC.Tag = "Par_pav" Then
            x = CC.Range.Text
            Client.Add Item:=x
        ElseIf CC.Tag = "Package" Then
         'I needed for value to start in upper case, and since in original document its written in lower case used this code
            x = CC.Range.Text
            x = UCase(Left(x, 1)) & Mid(x, 2)
            pack.Add Item:=x
        End If
    Next CC

    For Each TagCC In ccRepSec.Range.ContentControls
        If TagCC.Tag = "LI_NO" Then
            i = i + 1
            Set objDoc = objWord.Documents.Add(Template:="S:\shared\LI\LI_template.dotm", NewTemplate:=False, DocumentType:=0)
            objWord.Visible = True

            With objDoc

                .ContentControls.Item(1).Range.Text = Reg_number(i)
                .ContentControls.Item(2).Range.Text = VP_name(i)
                .ContentControls.Item(5).Range.Text = Client(i)
                .ContentControls.Item(4).Range.Text = pack(i)

                ' I wanted for name to have middle part of Reg_number variable so used code below, to extract it
                Number = Split(Reg_number(i), "/")(3)
                NewFileName = Number & Format(Now, "_yyyy-mm-dd") & ".docx"
                'I wanted to save documents in the same place as original document is located
                .SaveAs2 FileName:=Application.Documents(Application.Documents.Count).Path & "\\" & NewFileName
            End With
        End If
    Next TagCC

    MsgBox "Documents are created. Continue."

End Sub
于 2018-10-26T06:30:08.103 回答