创建带有下拉列表内容控件的自动填充word文档

Question

首先我需要承认，我对在 Word 中创建宏一无所知，但我想让自己在工作场所更轻松地处理文档，为此我想创建一个宏将根据在下拉列表内容控件中选择的选项更改 Word 文档中的文本。

比如我插入Word文档的下拉列表中有：

• 选项1
• 选项2

如果我从列表中选择选项 1，我希望分配给选项 1 的文本出现在 Word 文档中的特定位置。 如果我将选择从选项 1 更改为选项 2，我希望分配给选项 1 的文本被分配给选项 2 的文本替换。 如果两个选项都没有选择，我不希望在文档中的特定位置显示任何文本。

是否有可能为以这种方式工作的宏创建代码？如果是这样，我将不胜感激你的帮助。

我试图在 GPT 聊天中描述这一点，但我得到的并不像我上面描述的那样有效。使用 GPT 聊天的效果是，只有当我在 Word 中运行宏时已经选择了其中一个选项时，文本才会出现。更重要的是，当我选择了一个选项而不是运行宏时选择的选项时，通过 GPT 聊天创建的宏没有通过更改文本来响应。

这是我从 ChatGPT 得到的代码：

Sub Makro6()
    Dim cc As Contentcontrol
    Dim selectedValue As String
    
    For Each cc In ActiveDocument.ContentControls
        If cc.Title = "Subsystem" Then
            selectedValue = cc.Range.Text
            Exit For
        End If
    Next cc
    
    Select Case selectedValue
        Case "Option1"
            UpdateOrCreateBookmark "Option_1", "Text for Option1"
            ToggleBookmarkVisibility "Option_1", True
            ToggleBookmarkVisibility "Option_2", False
        Case "Option2"
            UpdateOrCreateBookmark "Option_1", "Text for Option2"
            ToggleBookmarkVisibility "Option_1", False
            ToggleBookmarkVisibility "Option_2", True
        Case Else
            ToggleBookmarkVisibility "Option_1", False
            ToggleBookmarkVisibility "Option_2", False
    End Select
End Sub

Sub UpdateOrCreateBookmark(bookmarkName As String, bookmarkText As String)
    Dim bm As Bookmark
    On Error Resume Next
    Set bm = ActiveDocument.Bookmarks(bookmarkName)
    On Error GoTo 0
    
    If bm Is Nothing Then
        ' Bookmark does not exist add new one
        ActiveDocument.Bookmarks.Add bookmarkName, Selection.Range
        ActiveDocument.Bookmarks(bookmarkName).Range.Text = bookmarkText
    Else
        ' Bookmark exists update its text
        bm.Range.Text = bookmarkText
    End If
End Sub

Sub ToggleBookmarkVisibility(bookmarkName As String, visible As Boolean)
    Dim bm As Bookmark
    On Error Resume Next
    Set bm = ActiveDocument.Bookmarks(bookmarkName)
    On Error GoTo 0
    
    If bm Is Nothing Then
        ' Bookmark does not exist
        Exit Sub
    Else
        ' Show/hide bookmark
        bm.Range.Font.Hidden = Not visible
    End If
End Sub

Answer 1

现在你可以再试一次，看看这是不是你想要的。

祝你好运！

Sub Makro6()
    Dim cc As ContentControl
    Dim selectedValue As String
    
    For Each cc In ActiveDocument.ContentControls
        If cc.Title = "Subsystem" Then '"Subsystem" is what you Name(Title) the drop-down listBox
            selectedValue = cc.Range.Text
            Exit For
        End If
    Next cc
    
    'not found cc.Title = "Subsystem"
    If cc Is Nothing Then
        Exit Sub
'    Else
'        Dim combo As ComboBox
'        Set combo = cc.DropdownListEntries
    End If
    
    'add item(Entries) to the drop-down listBox
    If cc.DropdownListEntries.Count = 1 Then 'Text= "選擇一個項目。" ; Value="" 'this is what default showing in my traditional Chinese version MS Word
        With cc.DropdownListEntries
            'the second argument is the text which be printed in doc
            .Add "Option1", "option 1"
            .Add "Option2", "option 2"
        End With
        
    End If
    
    'bookmark (text which to insert to the doc ) can not in the listBox
    'where to print the text you selected,where to place the insertion point
    If Selection.Information(wdInContentControl) Then
        MsgBox "Please place the insertion point in the appropriate position!", vbExclamation
        Exit Sub
    End If

    'get the data in DropdownListEntries
    Dim e As ContentControlListEntry, Text2Show As String
    For Each e In cc.DropdownListEntries
        If e = selectedValue Then
            Text2Show = e.Value
'            Stop
            Exit For
        End If
    Next e
    'base on your code given by chatGPT so still use bookmark to do
    UpdateOrCreateBookmark "Option", Text2Show '"Text for Option1"

End Sub

Sub UpdateOrCreateBookmark(bookmarkName As String, bookmarkText As String)
    Dim bm As Bookmark, rng As Range
    On Error Resume Next
    Set bm = ActiveDocument.Bookmarks(bookmarkName)
    On Error GoTo 0
   
   
    If bm Is Nothing Then
        ' Bookmark does not exist add new one
        Set rng = Selection.Range
        rng.Text = bookmarkText
        ActiveDocument.Bookmarks.Add bookmarkName, rng 'Selection.Range
'        ActiveDocument.Bookmarks(bookmarkName).Range.Text = bookmarkText
    Else
        ' Bookmark exists update its text
        Set rng = bm.Range
        'bm.Range.Text = bookmarkText
        rng.Text = bookmarkText 'as soon as bm.Range.Text = "" then the bookmark will be kill
        ActiveDocument.Bookmarks.Add bookmarkName, rng 'rebuild the bookmark at the same position
    End If
End Sub