Excel VBA - 将组合框插入 MS Word答案

【问题标题】：Excel VBA - Insert combo boxes into MS WordExcel VBA - 将组合框插入 MS Word
【发布时间】：2021-05-11 09:48:39
【问题描述】：

我有一个 Excel 工作簿，它创建一个表格并将表格导出到 MS Word。我的客户现在还想在单词表的最后一列中插入一个下拉列表。我找不到这方面的任何材料。可以做到吗？我想创建一个组合框并将其插入“解释”列中的每个单元格中。有人可以指出我正确的方向或提供一些示例代码吗？

当前代码：

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

【问题讨论】：

您可以遍历单元格并为每个单元格添加ContentControl。
我对单词对象还不是很熟悉。 Excel 没问题，但 VBA 这个词对我来说是第一次。我去看看
如果在功能区版本的 Word 中工作，您应该添加组合内容控件。 Greg Maxey 在他的网站上讨论了内容控件的代码。 gregmaxey.com/word_tip_pages/content_controls.htmlJohn Korcok brandwares.com/bestpractices/2019/08/…也是如此@
当然，如果您使用的 Word 模板中已经有一个表格，则一直到以“测试类型”开头的行下方的第一个数据行，并且所需的内容控件已经在最后一个行，您需要做的就是通过 FormattedText 方法为源中的每个数据行复制该行。这样，您就不需要为每一行创建和填充内容控件。
不幸的是，没有固定的行数，并且目标文件是根据具体情况而定的。用户进行输入并将其附加到现有报告中。

标签： excel vba ms-word combobox

【解决方案1】：

我能够让它与下面的代码一起工作。感谢那些建议我研究 ContentControl 的人。

现在我间歇性地收到“运行时错误 462。远程服务器计算机不存在或不可用。”

当问题完全解决后，我会在这里更新。

    
    '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

【讨论】：