Using VBA for-loops to edit ActiveX Control label captions

user_16596725 0
Viewed 35

I have a set of word documents that I want to auto-fill for different clients and I am trying to write a VBA application to accomplish that. I have information about the client, such as today's date and their name, stored in an Excel sheet, and I want to copy that information on multiple Word documents with labels on them. The goal is for every new client, the user would only need to update the client information on the Excel sheet to auto-fill the Word documents.

The below code is what I have right now. objDocument represents the Word document that I am trying to fill in and exWb is the Excel sheet in which I am trying to copy client information from. The Excel sheet has cells named TodayDate and ClientName which stores the respective client information. The Word document has ActiveX control labels named TodayDate, ClientName, and ClientName1 which will be filled in with the corresponding information from the Excel Sheet. ClientName and ClientName1 both contain the information from the "ClientName" cell, but because I cannot have 2 labels of the same name in Word, they are named as such.

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

To make the code more readable, I would like to format it into a for loop, but I am not sure how to declare a variable that can refer to the names of Word document labels in a for loop. I was thinking of using arrays to store the names of Word labels and Excel cells and loop through the list. I suppose it would look something like this:

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

Or to make it even better, use a dictionary with ExcelNames as the key and WordLabelList as the values so that I do not have to repeat values in the ExcelNames array:

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

Please let me know how I can achieve any of the above with proper VBA syntax or if you have a more efficient suggestion that is better than re-writing multiple lines in original code.

vba excel
1 Answers

The only thing you're missing seem to be a way to address an ActiveX control by its name? Once you have that your code gets much simpler.

For example:

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
user_4788840
Related