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

Question

我正在尝试将数据从 Excel 工作簿传输到预先存在的 Word 文档。

在 Excel 工作簿中，我为 shippingnumber、PO、Shipto 创建了一个名称，然后在名为“ShipmentSummary”的工作表上为每个重量和批次创建了一个名称。

我在 Word 文档中添加了名为 shippingnumber、PO、shipto 的内容控件，然后为每个需要填写重量和批号的货点添加了标题。

我希望将 Excel 中的货件编号传输到带有名为“shipment”的内容控件的 Word 文档，将 Excel 中的 PO 传输到带有名为“PO”的内容控件的 Word 文档，将 Excel 中的 ShipTo 传输到 Word包含名为“ShipTo”的内容控件的文档。Word 文档中每个shipmentnumber、PO 和shipto 控件有50 个。然后，我希望将名为“VBA_data”的工作表中的权重值传输到内容控件标题为 w1-w50 的 Word 文档中。最后，我希望将工作表名称“VBA_data”中的批次值传输到控件标题为 l1-l50 的 Word 文档中。

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

标签： excelvbams-word

Answer 1

未经测试：

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