MS Word,颜色更改链接到下拉菜单

时间:2017-11-15 21:56:17

标签: drop-down-menu colors ms-word word-vba

我有一个Word模板,其中包含标题中的选项,其中一个是与其相关的文档类型。我可以从下拉菜单中选择细胞毒性和单克隆选项。

我需要在文档上显示一些标识符颜色,黄色表示细胞毒性,蓝色表示单克隆。帮助快速识别以提高可用性。

是否有办法根据选择的选项更改形状或文本框颜色?

修改 该模板是一项正在进行的工作,因此不能100%确定添加颜色的位置,只是因为它将自动化以实现均匀性,因为它将应用于许多文档。并由不同的人工作。

我正在使用excel条件格式化类型效果,如果下拉列表显示细胞毒性颜色应用。它可以是形状,文本框,单元格或字体,我可以使用任何可能的链接。

感谢您的帮助!

1 个答案:

答案 0 :(得分:1)

请将以下代码粘贴到模板的ThisDocument代码表中,并以DOTM或DOCM格式将其保存为启用宏。

将ActiveX组合框添加到模板中。默认情况下,它的名称为" ComboBox1"。您会发现代码通过此名称引用它。

在模板中添加矩形。我把它做成了一个大约5毫米高的横条,横跨整个页面宽度。默认情况下,Word将调用它"矩形1"。请注意,代码通过此名称引用它。

Option Explicit

Private Sub Document_Open()
    ' 16 Nov 2017

    Dim iShp As InlineShape
    Dim Shp As Shape
    Dim ShapesCount As Integer

    For Each iShp In ActiveDocument.InlineShapes
        With iShp
            If .Type = wdInlineShapeOLEControlObject Then
                If StrComp(.OLEFormat.Object.Name, "ComboBox1", vbTextCompare) _
                           = 0 Then ShapesCount = ShapesCount + 1
            End If
        End With
    Next iShp

    For Each Shp In ActiveDocument.Shapes
        With Shp
            If .Type = msoAutoShape Then
                If StrComp(.Name, "Rectangle 1", vbTextCompare) _
                           = 0 Then ShapesCount = ShapesCount + 1
            End If
        End With
    Next Shp

   If ShapesCount < 2 Then
        MsgBox "One of the required shapes is missing.", _
               vbInformation, "Corrupted document"
        Exit Sub
    Else
        With ActiveDocument
            With .ComboBox1
                .List = Array("Cycotoxic", "Monoclonic")
                If .ListIndex < 0 Then .ListIndex = 0
            End With
        End With
    End If
End Sub

Private Sub ComboBox1_Change()
    ' 16 Nov 2017
    Shapes("Rectangle 1").Fill.ForeColor = Array(vbYellow, 15773696)(ComboBox1.ListIndex)
End Sub

当您打开文档时,将运行Document_Open事件过程(对于测试,您也可以手动运行)。它检查两个形状是否存在 - 一个是Inlineshape,另一个是正常形状 - 如果其中一个缺失,则会给出错误消息。它还将为Combobox添加两个选项。您将在代码中找到名称(如果我拼错了它们)。

现在,当您更改选择时,条形图的颜色将在黄色和蓝色之间切换。

统计:32行支持代码,这样一条单行就可以完成所有工作。

以下代码将在标题中包含矩形。不幸的是,在标题中不可能有一个ActiveX控件,但您可以将ComboBox格式化为没有框架,只有当鼠标悬停在它上面时才会显示下拉箭头,以便所选单词显示为部分该文件的文字,甚至可能是它的标题。

Option Explicit

Private Sub Document_Open()
    ' 17 Nov 2017

    Dim iShp As InlineShape

    For Each iShp In ActiveDocument.InlineShapes
        With iShp
            If .Type = wdInlineShapeOLEControlObject Then
                If StrComp(.OLEFormat.Object.Name, "ComboBox1", vbTextCompare) = 0 Then
                    With .OLEFormat.Object
                        .List = Array("Cycotoxic", "Monoclonic")
                        If .ListIndex < 0 Then .ListIndex = 0
                    End With
                End If
            End If
        End With
    Next iShp
End Sub

Private Sub ComboBox1_Change()
    ' 17 Nov 2017

    Dim Sect As Object, Story As Object
    Dim Shp As Shape

    With ActiveDocument
        For Each Sect In .Sections
            For Each Story In Sect.Headers
                For Each Shp In Story.Shapes
                    With Shp
                        If .Type = msoAutoShape Then
                            If StrComp(.Name, "Rectangle 1", vbTextCompare) = 0 Then
                                Shap.Fill.ForeColor = Array(vbYellow, 15773696)(ComboBox1.ListIndex)
                            End If
                        End If
                    End With
                Next Shp
            Next Story
        Next Sect
    End With
End Sub

请注意,此版本不检查文档是否存在ComboBox或Rectangle。相反,如果找到ComboBox,则设置其下拉列表。如果没有发现任何事情都会发生。如果没有ComboBox来调用它的更改事件,矩形中的颜色将不会发生变化,特别是如果它不存在的话。