从 Excel 表格查找并替换 Word 文档

Question

我正在尝试在 Excel 中创建一个可以填充的订单表格，然后按一下按钮即可完成基于单词的订单表格（将另存为 PDF）发送给客户。

我知道这不是最好的方法——但是对于我工作的公司来说，实施大的改变是有困难的，所以这是我获得总监的中间概念证明在船上。

无论如何...这是我的代码。效果很好！直到Word文档中表格中的位。然后查找和替换似乎失败了。为了清楚起见 - 标记为“订单表格”的部分是拒绝工作的部分。

编辑：包括之前/之后的屏幕截图

有什么建议吗？

Sub ReplaceText()Dim wApp As Object
Set wApp = CreateObject(Class:="Word.Application")
wApp.Visible = True

Set wDoc = wApp.Documents.Add(Template:="FILE LOCATION", NewTemplate:=False, DocumentType:=0)

With wDoc

'Customer Information


    .Application.Selection.Find.Text = "<FT1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B5")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<FT2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B2")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<FT3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B3")
    .Application.Selection.EndOf

'Customer Address

    .Application.Selection.Find.Text = "<AD1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B4")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<AD2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B12")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<AD3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C12")
    .Application.Selection.EndOf

'Order Form
'Column 1

    .Application.Selection.Find.Text = "<Q1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("A23")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<Q2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("A24")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<Q3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("A25")
    .Application.Selection.EndOf

'column2

    .Application.Selection.Find.Text = "<DESC1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B23")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<DESC2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B24")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<DESC3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("B25")
    .Application.Selection.EndOf

'column3

    .Application.Selection.Find.Text = "<IC1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C23")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<IC2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C24")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<IC3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C25")
    .Application.Selection.EndOf
    
    'Column4
    
    .Application.Selection.Find.Text = "<RM1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("D23")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<RM2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("D24")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<RM3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("D25")
    .Application.Selection.EndOf

'Column5

    .Application.Selection.Find.Text = "<CTM1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("E23")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<CTM2>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("E24")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<CTM3>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("E25")
    .Application.Selection.EndOf

'Total Price

    .Application.Selection.Find.Text = "<TP1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C31")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<TV1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C32")
    .Application.Selection.EndOf
    
    .Application.Selection.Find.Text = "<TC1>"
    .Application.Selection.Find.Execute
    .Application.Selection = Range("C33")
    .Application.Selection.EndOf
    
    .SaveAs2 Filename:=("FILE LOCATION")
    'FileFormat:=wdFormatXMLDocument, AddtoRecentFiles:=False

End With

End Sub

Answer 1

您有很多代码，如果您创建一个映射表来将每个令牌与其相应的值源范围链接起来，这些代码会更容易管理。

例如：

Option Explicit

Sub ReplaceText()
    
    Dim wApp As Object, wDoc As Object, rngMap As Range, rw As Range, wsData As Worksheet
    Dim res As Boolean, token As String, txt
    
    Set wApp = GetObject(Class:="Word.Application") 'using an open Word document for testing....
    
    wApp.Visible = True
    
    Set wDoc = wApp.Documents(1)
    
    Set wsData = ThisWorkbook.Worksheets("Data") 'for example
    'reference mapping table
    Set rngMap = ThisWorkbook.Worksheets("Mapping").ListObjects(1).DataBodyRange
    
    For Each rw In rngMap.Rows
        token = rw.Cells(1).Value                   'placeholder to be replaced
        txt = wsData.Range(rw.Cells(2).Value).Value 'value to replace with
        res = ReplaceToken(wDoc, token, txt)
        rw.Interior.COLOR = IIf(res, vbGreen, vbRed) 'flag succeed/fail
    Next rw
    
End Sub

'In word document `doc`, replace `<token>` with `txt`
Function ReplaceToken(doc As Object, token As String, txt) As Boolean
    Const wdReplaceAll = 2
    Dim rng As Object
    Set rng = doc.Content
    ReplaceToken = rng.Find.Execute(FindText:="<" & token & ">", _
                     ReplaceWith:=txt, _
                     Replace:=wdReplaceAll)
End Function

映射表如下所示：