使用 contentcontrolsbytitle() 将数据从 Excel 传输到 Word 文档

Question

I am trying to transfer data from the Excel workbook to a pre-existing Word document.

Within the Excel workbook, I have created a name for shipmentnumber, PO, Shipto, and then a name for each weight and lots on the worksheet named "ShipmentSummary".

I have added content controls on the Word document called shipmentnumber, PO, shipto and then a title for each spot a weight and lot number needs to go.

I want the shipmentnumber from Excel to be transferred to the Word document with the content controls called "shipment", PO from Excel to be transferred to the Word document with the content controls called "PO", ShipTo from Excel to be transferred to the Word document with the content controls called "ShipTo". There are 50 of each shipmentnumber,PO and shipto controls on the Word document. I then want the weight values from the worksheet named "VBA_data" to be transferred to the Word document with content controls title w1-w50. Lastly I want the lot values from the worksheet name "VBA_data" to be transferred to the Word document with control title l1-l50.

Sub ReplaceControlsOnCaseLabel()
    Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim cc As ContentControl
    Dim rngCC As Word.Range
    
   set the word application and word document
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open("C:\Users\tyler.masson\Desktop\Shipment_VBA\Case Labels.docx")
    wordApp.Visible = True

'Send value of shipment number in excel workbook to word document with content controls titled "shipment", there are 50 in total.
    For Each cc In wDoc
        If cc.Title = "shipment" Then
            ActiveDocument.Sheets("ShipmentSummary").Range("shipmentnumber").Value
        End If
    Next
    
 'Send value of PO in excel workbook to word document with content controls titled "PO", there are 50 in total.
    For Each cc In wDoc
        If cc.Title = "PO" Then
            ActiveDocument.Sheets("ShipmentSummary").Range("PO").Value
        End If
    Next
    
 'Send value of shipto in excel workbook to word document with content controls titled "shipto", there are 50 in total.
    For Each cc In wDoc
        If cc.Title = "shipto" Then
            ActiveDocuments.Sheets("ShipmentSummary").Range("ShipTo").Value
        End If
    Next
    
    
'Send values of each weight from worksheet "VBA_data" to the word document with contentcontrols title w1-w50
    With wordApp.ActiveDocument
        wDoc.SelectContentControlsByTitle("w1") = ActiveDocument.Sheets("VBA_data").Range("w1").Value
        wDoc.SelectContentControlsByTitle("w2") = ActiveDocument.Sheets("VBA_data").Range("w2").Value
        wDoc.SelectContentControlsByTitle("w3") = ActiveDocument.Sheets("VBA_data").Range("w3").Value
        wDoc.SelectContentControlsByTitle("w4") = ActiveDocument.Sheets("VBA_data").Range("w4").Value
        wDoc.SelectContentControlsByTitle("w5") = ActiveDocument.Sheets("VBA_data").Range("w5").Value
        wDoc.SelectContentControlsByTitle("w6") = ActiveDocument.Sheets("VBA_data").Range("w6").Value
        wDoc.SelectContentControlsByTitle("w7") = ActiveDocument.Sheets("VBA_data").Range("w7").Value
        wDoc.SelectContentControlsByTitle("w8") = ActiveDocument.Sheets("VBA_data").Range("w8").Value
        wDoc.SelectContentControlsByTitle("w9") = ActiveDocument.Sheets("VBA_data").Range("w9").Value
        wDoc.SelectContentControlsByTitle("w10") = ActiveDocument.Sheets("VBA_data").Range("w10").Value
    End With


'Send values of each lot from worksheet "VBA_data" to the word document with contentcontrols title l1-l50
    With wordApp.ActiveDocument
        w wDoc.SelectContentControlsByTitle("l1") = ActiveDocument.Sheets("VBA_data").Range("l1").Value
        wDoc.SelectContentControlsByTitle("l2") = ActiveDocument.Sheets("VBA_data").Range("l2").Value
        wDoc.SelectContentControlsByTitle("l3") = ActiveDocument.Sheets("VBA_data").Range("l3").Value
        wDoc.SelectContentControlsByTitle("l4") = ActiveDocument.Sheets("VBA_data").Range("l4").Value
        wDoc.SelectContentControlsByTitle("l5") = ActiveDocument.Sheets("VBA_data").Range("l5").Value
        wDoc.SelectContentControlsByTitle("l6") = ActiveDocument.Sheets("VBA_data").Range("l6").Value
        wDoc.SelectContentControlsByTitle("l7") = ActiveDocument.Sheets("VBA_data").Range("l7").Value
        wDoc.SelectContentControlsByTitle("l8") = ActiveDocument.Sheets("VBA_data").Range("l8").Value
        wDoc.SelectContentControlsByTitle("l9") = ActiveDocument.Sheets("VBA_data").Range("l9").Value
        wDoc.SelectContentControlsByTitle("l10") = ActiveDocument.Sheets("VBA_data").Range("l10").Value
    End With
        
'Another way to send values to contentcontrolbytitle() ???
    'weight1 = wDoc.SelectContentControlsByTitle("w1") = ActiveDocument.Sheets("VBA_data").Range("w1").Value
    'weight2 = wDoc.SelectContentControlsByTitle("w2") = ActiveDocument.Sheets("VBA_data").Range("w2").Value
    'weight3 = wDoc.SelectContentControlsByTitle("w3") = ActiveDocument.Sheets("VBA_data").Range("w3").Value
    'weight4 = wDoc.SelectContentControlsByTitle("w4") = ActiveDocument.Sheets("VBA_data").Range("w4").Value
    'weight5 = wDoc.SelectContentControlsByTitle("w5") = ActiveDocument.Sheets("VBA_data").Range("w5").Value
    'weight6 = wDoc.SelectContentControlsByTitle("w6") = ActiveDocument.Sheets("VBA_data").Range("w6").Value
    'weight7 = wDoc.SelectContentControlsByTitle("w7") = ActiveDocument.Sheets("VBA_data").Range("w7").Value
    'weight8 = wDoc.SelectContentControlsByTitle("w8") = ActiveDocument.Sheets("VBA_data").Range("w8").Value
    'weight9 = wDoc.SelectContentControlsByTitle("w9") = ActiveDocument.Sheets("VBA_data").Range("w9").Value
    'weight10 = wDoc.SelectContentControlsByTitle("w10") = ActiveDocument.Sheets("VBA_data").Range("w10").Value

    
End Sub

Answer 1

Untested:

Sub ReplaceControlsOnCaseLabel()
    
    Dim wordApp As Word.Application
    Dim wDoc As Word.document
    Dim cc As ContentControl, wsData As Worksheet
    Dim rngCC As Word.Range, wsShipment As Worksheet, i As Long
    
    'set the word application and word document
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open("C:\Users\tyler.masson\Desktop\Shipment_VBA\Case Labels.docx")
    wordApp.Visible = True

    Set wsShipment = ActiveWorkbook.Sheets("ShipmentSummary") 'or ThisWorkbook
    Set wsData = ActiveWorkbook.Sheets("VBA_data")

    SetCCValueByTitle wDoc, "shipment", wsShipment.Range("shipmentnumber").Value
    SetCCValueByTitle wDoc, "PO", wsShipment.Range("PO").Value
    SetCCValueByTitle wDoc, "shipto", wsShipment.Range("ShipTo").Value
    
    For i = 1 To 10
        SetCCValueByTitle wDoc, "w" & i, wsData.Range("W" & i).Value
        SetCCValueByTitle wDoc, "l" & i, wsData.Range("L" & i).Value
    Next i
    
End Sub

'set text to CCValue in all controls with Title = CCTitle 
Sub SetCCValueByTitle(doc As Word.document, CCTitle, CCValue)
    Dim cc As Word.ContentControl, ccs As Word.ContentControls
    Set ccs = doc.SelectContentControlsByTitle(CCTitle)
    'warn if none found
    If ccs.Count = 0 Then MsgBox "No controls with title '" & CCTitle & "'"
    For Each cc In ccs
        cc.Range.Text = CCValue
    Next cc
End Sub