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




Reply With Quote