Hi!
I have 2 file include(01: Excel Data, 02: Word Template)
I need help export data from excel to Word template
Help me Write code VBA Excel -> Result: Report have Checkbox Content Control
Thanks!
Map.jpg
Hi!
I have 2 file include(01: Excel Data, 02: Word Template)
I need help export data from excel to Word template
Help me Write code VBA Excel -> Result: Report have Checkbox Content Control
Thanks!
Map.jpg
Change the two text items in the document for rich text content controls titled Name and Tel
Save the document in the same folder as the workbook
Add the following code to the worksheet module
Assign the code to the button.
Option Explicit Sub Macro1() 'Graham Mayor - https://www.gmayor.com - Last updated - 04 Sep 2020 Dim wdApp As Object Dim wdDoc As Object Dim oCC As Object On Error Resume Next Set wdApp = GetObject(, "Word.Application") If Err Then Set wdApp = CreateObject("Word.Application") End If On Error GoTo 0 ThisWorkbook.Save Set wdDoc = wdApp.Documents.Add(Template:=ThisWorkbook.Path & "\Template.docx") For Each oCC In wdDoc.contentcontrols Select Case oCC.Title Case "ckMale" If Range("B3") = 1 Then oCC.Checked = True Else oCC.Checked = False End If Case "ckFemale" If Range("B4") = 1 Then oCC.Checked = True Else oCC.Checked = False End If Case "ckNew" If Range("B5") = 1 Then oCC.Checked = True Else oCC.Checked = False End If Case "ckFix" If Range("B6") = 1 Then oCC.Checked = True Else oCC.Checked = False End If Case "Name" oCC.Range.Text = Range("B2") Case "Tel" oCC.Range.Text = Range("B7") End Select Next oCC lbl_Exit: Set oCC = Nothing Set wdDoc = Nothing Set wdApp = Nothing Exit Sub End Sub
Graham Mayor - MS MVP (Word) 2002-2019
Visit my web site for more programming tips and ready made processes
http://www.gmayor.com
Help me edit code below: It working but I don't use Select case
Option Explicit
Sub Macro2()
Application.ScreenUpdating = False
'Graham Mayor - https://www.gmayor.com - Last updated - 04 Sep 2020
Dim wdApp As Object
Dim wdDoc As Object
Dim oCC As Object
Dim rngSH As Range
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Worksheets("sheet1").Activate
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(ThisWorkbook.Path & "\Template.docx")
wdApp.Documents(ThisWorkbook.Path & "\Template.docx").SaveAs Filename:=ThisWorkbook.Path & "\Result.docx"
For Each oCC In wdDoc.contentcontrols
Select Case oCC.Title
Case "ckMale"
If Range("B3") = 1 Then
oCC.Checked = True
Else
oCC.Checked = False
End If
Case "ckFemale"
If Range("B4") = 1 Then
oCC.Checked = True
Else
oCC.Checked = False
End If
Case "ckNew"
If Range("B5") = 1 Then
oCC.Checked = True
Else
oCC.Checked = False
End If
Case "ckFix"
If Range("B6") = 1 Then
oCC.Checked = True
Else
oCC.Checked = False
End If
End Select
Next oCC
For Each rngSH In Sheets("Sheet1").Range([A2], [A65000].End(3))
wdApp.Selection.Find.Execute rngSH, , , , , , , , , Sheets("Sheet1").Range(rngSH(1, 2).Address(0, 0)), 2
Next
wdApp.Documents.Save
lbl_Exit:
Set oCC = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing
Exit Sub
Application.ScreenUpdating = True
End Sub
Last edited by toangm; 09-06-2020 at 07:40 AM.