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。

VBA Excel自动模板选择

1 个答案: