VBA Excel Автоматический выбор шаблона

Question

Я пишу сценарий VBA, с помощью которого я хочу выполнять более умные функции слияния.

По сути, у меня есть 3 шаблона слов, которые по-разному отформатированы с использованием тегов замены в разных местах.Мы назовем эти шаблоны 1-3.

У меня есть таблица, в которой каждая строка содержит необходимые данные для замены в виде строк, максимум 6 строк в строке.Слева от этой таблицы, в столбце B, у меня есть количество строк в таблице, и на основании этого числа я хочу, чтобы он выбрал правильный шаблон.Я думаю, что у меня неправильно настроен LeftCell dim, или мой код правильно выбирает шаблон в первый раз, но применяет его ко всем другим строкам.Если я запускаю сценарий, он, кажется, всегда выбирает первый шаблон.

Sub CreateWordDocuments()
Dim CustRow, CustCol, LastRow, LeftCell, TemplRow As Long
Dim DocLoc, TagName, TagValue, TemplName, FileName As String
Dim WordDoc, WordApp As Object
Dim WordContent As Word.Range
With Sheet1

If .Range("B3").Value = Empty Then
    MsgBox "Please select a template from the dropdown list"
    .Range("G3").Select
    Exit Sub
End If
    TemplRow = .Range("B3").Value 'Set Template Row
    TemplName = .Range("G3").Value 'Set Template Name
    DocLoc = Sheet2.Range("F" & TemplRow).Value 'Word Doc Filename

    'Open Word Template
    On Error Resume Next 'If Word is already running
    Set WordApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    'Launch a new instance of Word
    Err.Clear
    'On Error GoTo Error_Handler
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True 'Make the application visible to the user
    End If


    LastRow = .Range("E999").End(xlUp).Row 'Determine last row
    LeftCell = .Range("B" & (ActiveCell.Row)).Value
    For CustRow = 8 To LastRow
                If LeftCell = 6 Then
                    Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 1.docx", ReadOnly:=False) 'Open Template
                ElseIf LeftCell = 4 Then
                    Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 2", ReadOnly:=False) 'Open Template
                Else: LeftCell = 3
                    Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 3.docx", ReadOnly:=False) 'Open Template
                End If

                    For CustCol = 5 To 10 'Move through 3 columns
                        TagName = .Cells(7, CustCol).Value  'Tag Name
                        TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                        With WordDoc.Content.Find
                            .Text = TagName
                            .Replacement.Text = TagValue
                            .Wrap = wdFindContinue
                            .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                        End With
                    Next CustCol
    WordDoc.PrintOut
    WordDoc.Close
    Kill (FileName) 'Deletes the Word File just created
Next CustRow
WordApp.Quit

End With
End Sub

Не обращая внимания на несколько строк кода, касающихся b3 и g3, я сохраняю это для последующей функциональности, чтобы, возможно, выбрать различные наборы шаблонов.

Answer 1

Вам нужно перемещать Leftcell внутри цикла и увеличивать его с каждой итерацией:

For CustRow = 8 To LastRow
    LeftCell = .Range("B" & CustRow).Value
            If LeftCell = 6 Then
                Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 1.docx", ReadOnly:=False) 'Open Template
            ElseIf LeftCell = 4 Then
                Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 2", ReadOnly:=False) 'Open Template
            Else: LeftCell = 3
                Set WordDoc = WordApp.Documents.Open("C:\Users\jhabermann\Desktop\Excel VBA Test Environment\Template 3.docx", ReadOnly:=False) 'Open Template
            End If

                For CustCol = 5 To 10 'Move through 3 columns
                    TagName = .Cells(7, CustCol).Value  'Tag Name
                    TagValue = .Cells(CustRow, CustCol).Value 'Tag Value
                    With WordDoc.Content.Find
                        .Text = TagName
                        .Replacement.Text = TagValue
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
                    End With
                Next CustCol
    WordDoc.PrintOut
    WordDoc.Close
    Kill (FileName) 'Deletes the Word File just created
Next CustRow

В качестве примечания, не уверен, что вы делаете в этой строке Else: LeftCell = 3 - зачем устанавливать LeftCell ни к чему?Я думаю, что вы имели в виду для другого ElseIf там.