Quote Originally Posted by gmayor View Post
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


Thank you very much!
But I have multi value in row at colum A in "Excel_Data_Run_Macro.xlsm". I want type as "loop" don't use "Select Case"