Для каждого цикла мгновенно переходит к последнему результату

Question

Я пытаюсь сделать код для запуска через документ Word, содержащий повторяющиеся элементы управления содержимым раздела (RepSecCC), содержащий несколько вложенных 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 считался одним, поэтому в свою очередь создавался только один документ.

Мне удалось преодолеть эти проблемы, изменив принцип работы всего кода:

Во-первых, для каждого соответствующего CC, который я создал New Collection Затем я перебрал весь документ и добавил эти значения CC в соответствующие коллекции.

Затем я снова просмотрел документ и для каждого CC с определенным тегом создал новый документ, который взял значения из коллекций.Поскольку значения в коллекции были в последовательном порядке, я просто добавил счетчик, который подсчитал номер цикла и определил, какое значение из коллекции использовать.

Я уверен, что это, вероятно, не самый эффективный способ, но он работает иработает с удовлетворительной скоростью.

Мой окончательный код, может быть, кто-то может использовать его:

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