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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.