Excel VBA - 将组合框插入 MS Word

Question

I have a an Excel workbook with that creates a table and exports the table to MS word. My client now wants to also insert a drop down list into the last column of the word table. I cannot find any material on this. Can it be done? I would like to create a combobox and insert it into each cell in the "Interpretation" column. Can someone point me in the right direction or supply some sample code?

Current code:

Sub ExportToWord()    
Dim ws As Worksheet
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim objRange As Word.Range
Dim bWeStartedWord As Boolean
Dim newDoc As Boolean, onSave As Boolean
Dim rng As Range
Dim lRow As Integer, s As Integer

If UF_Load.check_new = True Then
    newDoc = True
Else
    newDoc = False
End If

Set ws = ThisWorkbook.Sheets("UI")
On Error Resume Next
Set wrdApp = GetObject(, "Word.Application")
On Error GoTo 0

Application.ScreenUpdating = False
Application.EnableEvents = False

s = ws.Range("rng_demo").Row - 1
c = ws.Range("rng_demo").Column

lRow = ws.Cells(Rows.count, s).End(xlUp).Row

Set rng = ws.Range("A" & s).Resize(lRow, 8)
    rng.Copy

If wrdApp Is Nothing Then
    Set wrdApp = CreateObject("Word.Application")
    bWeStartedWord = True
End If

'Handle if Word Application is not found
If Err.Number = 429 Then
    MsgBox "Microsoft Word document could not be found, aborting", vbExclamtion, "Microsoft Word Error 429"
    GoTo SafeExit:
End If
    

On Error GoTo 0

'Make MS Word Visible and Active
    wrdApp.Visible = True
    wrdApp.Activate

'
wrdApp.Visible = True


If newDoc = True Then
    Set wrdDoc = wrdApp.Documents.Add 'create as new word document
    
    'Copy table data to word doc
    Set tbl = rng 'ThisWorkbook.Sheets("UI").Range("A4:H25")
    tbl.Copy

    'Paste Table into Word doc
    wrdDoc.Paragraphs(1).Range.PasteExcelTable _
                         LinkedToExcel:=False, _
                         WordFormatting:=False, _
                        RTF:=False
                        
    'Autofit table to Word doc
    Set wordtable = wrdDoc.Tables(1)
    wordtable.AutoFitBehavior (wdAutoFitWindow)
    

Else

'or open an existing document
    Set wrdDoc = wrdApp.Documents.Open(filepath) 'wrdApp.Documents.Open("C:\Users\Apache Paint\Desktop\Clients\Stephen Schmitz\TestDocument.docx")
    
    'Copy table data to word doc
    With wrdDoc
    Set tbl1 = .Tables.Add(Range:=wrdDoc.Paragraphs.Last.Range, _
               NumRows:=1, NumColumns:=8, _
               AutoFitBehavior:=wdAutoFitWindow) 'autofit content 'DefaultTableBehavior:=wdWord9TableBehavior,
    With tbl1
        
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        
    End With
    
    
    Set tbl = rng 'ThisWorkbook.Sheets("UI").Range("A4:H25")
    tbl.Copy
        
    Set objRange = wrdDoc.Content
    
    With objRange
        .Collapse Direction:=0 'wdCollapseEnd
        .InsertAfter vbCrLf
        .Collapse Direction:=0
        .InsertBreak Type:=wdPageBreak
        .Paste  '<< paste the table
    End With
    
    'Autofit the document
    Set wordtable = objRange.Tables(1)
    wordtable.AutoFitBehavior (wdAutoFitWindow)
    With wordtable
        .PreferredWidthType = wdPreferredWidthPercent
        .PreferredWidth = 100
        End With
    
   End With
    
filepath = ""
End If

    
SafeExit:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub

Answer 1

I was able to get it to work with the code below. Thanks to those who suggested I look into ContentControl.

Now I am intermittently getting 'Run-time error 462. The remote server machine does not exist or is unavailable.'

I will update the cooment back here when it is fully resolved.

    
    'Copy table data to word doc
    Set tbl = rng 'ThisWorkbook.Sheets("UI").Range("A4:H25")
    tbl.Copy

    'Paste Table into Word doc
    wrdDoc.Paragraphs(1).Range.PasteExcelTable _
                         LinkedToExcel:=False, _
                         WordFormatting:=False, _
                        RTF:=False
                           
    'Autofit table to Word doc
    Set Wordtable = wrdDoc.Tables(1)
    Wordtable.AutoFitBehavior (wdAutoFitWindow)
    Dim oRow As Row
    'Dim oRng As Range
     'Loop through last table column and add Combobox
     
With Wordtable
    For Each oRow In Wordtable.Rows
        'Set oRng = oRow.Cells(1).Range
        If Len(oRow.Cells(7).Range.Text) > 11 Then
            Set objCC = ActiveDocument.ContentControls.Add(wdContentControlDropdownList, oRow.Cells(8).Range)
            objCC.Title = "Interpretation"
            If objCC.ShowingPlaceholderText Then
            objCC.SetPlaceholderText , , "-Select-"
            objCC.DropdownListEntries.Add "Far Below Expectaions"
            objCC.DropdownListEntries.Add "Below Expectaions"
            objCC.DropdownListEntries.Add "Slightly Below Expectaions"
            objCC.DropdownListEntries.Add "Significant Difference"
            objCC.DropdownListEntries.Add "Valid"
            objCC.DropdownListEntries.Add "WNL"
            Debug.Print Len(oRow.Cells(7).Range.Text)
            
            End If
        Else
        End If
    Next
End With