Question

我正在尝试使代码运行在包含重复节内容控件（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

Answer 1

我自己弄清楚了，原来，我的初始代码有两个问题：

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

2）另一个问题是由于以下事实引起的：由于某种原因，重复CC部分不被视为单独的对象，因此，整个重复CC被计为一个，因此仅创建了一个文档。 / p>

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

首先，我为每个相关的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

对于每个循环，立即跳转到最后一个结果

1 个答案: