使用VBA for循环编辑ActiveX控件标签标题

Question

我有一组word文档，我想为不同的客户端自动填充，我正在尝试编写一个VBA应用程序来实现这一点。我有关于客户的信息，如今天的日期和他们的姓名，存储在Excel工作表中，我想将这些信息复制到多个带有标签的Word文档上。目标是，对于每个新客户端，用户只需要更新Excel工作表上的客户端信息即可自动填充Word文档。

下面的代码就是我现在拥有的。objDocument表示我试图填写的Word文档，exWb是我试图从中复制客户信息的Excel工作表。Excel工作表具有名为TodayDate和ClientName的单元格，用于存储各自的客户端信息。Word文档具有名为TodayDate、ClientName和ClientName1的ActiveX控件标签，这些标签将用Excel工作表中的相应信息填充。ClientName和ClientName1都包含来自"；ClientName"；单元格，但因为我在Word中不能有两个同名标签，所以它们是这样命名的。

Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
On Error Resume Next
objDocument.TodayDate.Caption = exWb.Sheets("Sheet1").Range("TodayDate").Value
On Error Resume Next
objDocument.ClientName.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next
objDocument.ClientName1.Caption = exWb.Sheets("Sheet1").Range("ClientName").Value
On Error Resume Next

为了使代码更可读，我想将其格式化为for循环，但我不知道如何在for循环中声明一个可以引用Word文档标签名称的变量。我正在考虑使用数组来存储Word标签和Excel单元格的名称，并在列表中循环。我想它看起来像这样：

Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
WordLabelList = [TodayDate, ClientName, ClientName1]
ExcelNames = ["TodayDate", "ClientName", "ClientName"]
Dim i as Integer
for i in range(1, length(WordLabelList))
On Error Resume Next
objDocument.WordLabelList[i].Caption = exWb.Sheets("Sheet1").Range(ExcelNames[i]).Value
Next

或者为了更好，使用一个以ExcelNames为键、WordLabelList为值的字典，这样我就不必重复ExcelNames数组中的值：

Dim objDocument As Document
Set objDocument = Documents.Open(strPath)
objDocument.Activate
Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Set exWb = objExcel.Workbooks.Open(selectMasterPath)
ClientInfo = {"TodayDate":[TodayDate], "ClientName": [ClientName, ClientName1]}
for info in ClientInfo
for label in ClientInfo[info].value
On Error Resume Next
objDocument.label.Caption = exWb.Sheets("Sheet1").Range(info).Value
Next

请告诉我如何使用正确的VBA语法实现上述任何一项，或者如果你有比在原始代码中重写多行更好的更有效的建议。

Answer 1

您唯一缺少的似乎是通过名称来寻址ActiveX控件的方法？一旦你有了它，你的代码就会变得简单多了。

例如：

Sub Tester()
Dim doc As Object, lbl As Object, nm

Set doc = ThisDocument
For Each nm In Array("TodayDate", "ClientName")
Set lbl = DocActiveX(doc, nm) 'get a reference to an embedded ActiveX control
If Not lbl Is Nothing Then
lbl.Caption = "this is - " & nm
Else
Debug.Print "Control '" & nm & "' not found"
End If
Next nm
End Sub
'return a reference to a named ActiveX control in document `doc`
'   (or Nothing if not found)
Function DocActiveX(doc As Document, xName) As Object
Dim obj As Object
On Error Resume Next
Set obj = CallByName(doc, xName, VbGet)
On Error GoTo 0
Set DocActiveX = obj
End Function