我有一个Word模板,其中包含标题中的选项,其中一个是与其相关的文档类型。我可以从下拉菜单中选择细胞毒性和单克隆选项。
我需要在文档上显示一些标识符颜色,黄色表示细胞毒性,蓝色表示单克隆。帮助快速识别以提高可用性。
是否有办法根据选择的选项更改形状或文本框颜色?
修改 该模板是一项正在进行的工作,因此不能100%确定添加颜色的位置,只是因为它将自动化以实现均匀性,因为它将应用于许多文档。并由不同的人工作。
我正在使用excel条件格式化类型效果,如果下拉列表显示细胞毒性颜色应用。它可以是形状,文本框,单元格或字体,我可以使用任何可能的链接。
感谢您的帮助!
答案 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来调用它的更改事件,矩形中的颜色将不会发生变化,特别是如果它不存在的话。