MS WORD TOC : 如何在标题中的字符“:”之前或之后添加不同的颜色？

Question

我有一个包含多个部分的 Word 文本文档，我已经创建了我的 table 内容。我创建了一个 TOC 以便能够自动更新它，它就是为此而使用的。通过 alt+F9 我有 TOC \O "1-2" \H \U

你可以看到我需要链接到 headers.

的符号 \H

我可以在 headers 我的标题的两点前后应用所需的颜色，形式如下： [xxxxx xxxx xxxx :（红色）] [yyyyy yyyyy yyyyy（黑色）]

我希望这种色差也出现在我的摘要 (TOC) 中。所以我添加指令 \* MERGEFORMAT 这给出： TOC \O "1-2" \* MERGEFORMAT \H \U

但是，这样做会丢失我的链接，因为指令 \H 不再有效。

所以我切换到VBA代码。

但我不知道怎么说 : xxxxxxx（红色）：xxxxxx（黑色）

x 是可变的，两个点 (:) 总是出现在我 headers 的标题中。从 2 点 (:) 开始，其余标题必须为黑色的代码是什么？或者在 2 点 (:) 之前标题的颜色必须是红色的？

例如：

Example/title:（红色）这是我的标题（黑色）

示例标题二：（红色）这是我的第二个示例（黑色）

Other/example/additional:（红色）这是最后一个标题（黑色）

感谢您的见解

编辑：

嗨，

`Dim I As Integer, J As Integer
 Dim MonTableau As Variant
 Dim ListePositionsMots As String
 Dim MonRange As Range


With ActiveDocument

     If .TablesOfContents.Count = 0 Then
        MsgBox "Aucune table des matières dans le document !", vbInformation
        Exit Sub
     End If

     With .TablesOfContents(1)
          J = 1
          For I = 1 To .Range.Words.Count
              If J <= 2 Then
                 If .Range.Words(I) <> "" Then ListePositionsMots = ListePositionsMots & I & ","
                 J = J + 1
              End If
              If .Range.Words(I) = Chr(13) Then J = 1
          Next I

          ListePositionsMots = Mid(ListePositionsMots, 1, Len(ListePositionsMots) - 1)
          MonTableau = Split(ListePositionsMots, ",")
          For I = LBound(MonTableau) To UBound(MonTableau)
              Set MonRange = ActiveDocument.TablesOfContents(1).Range
              MonRange.SetRange Start:=MonRange.Words(MonTableau(I)).Start, End:=MonRange.Words(MonTableau(I)).End
              With MonRange
                   If .Text <> Chr(9) Then
                      .Font.ColorIndex = wdRed
                      .Case = wdUpperCase
                    End If
              End With
              Set MonRange = Nothing
          Next I

      End With
End With`

晚上好，

上面的代码运行良好，允许我在 table 内容中为每个标题的前 2 个词着色。

x y（红色）: x y z（黑色）

v w（红色）: y z（黑色）

所以这是可能的。

由于有时我的标题超过2个字，我不得不修改它。我必须把这个词的值；在这种情况下，2 点字符 ( : ) 而不是它的位置。

x y z（红色）:（红色或黑色）x y z（黑色）

但我不知道 vba 代码可以做到这一点，这就是我在这个论坛上提问的原因，我确定有人可以帮助我吗？

谢谢。

编辑 2 (26/05/2021 10:45)：我再说一遍，我只需要 VBA 代码，仅此而已……谢谢。

Answer 1

您不需要任何代码。如果没有 \H 开关，Table 的目录将自动重现您应用于标题的任何字体颜色。顶多刷新Contents的Table即可。

即使没有 \H 开关，您的 Table 目录也会 link 通过页面 #s 引用的内容。 \H 开关所做的只是从目录文本的 Table 启用 linking。

无论如何，尝试使用 VBA（或手动）对内容的 Table 应用着色都是浪费时间，因为任何导致 Table要刷新的内容（例如打印预览或打印文档）将清除所有颜色。

无论如何，您甚至不需要宏来为您描述的 Table 内容着色 - 您只需要一个 通配符 Find/Replace 对 Contents 的 Table 操作，其中：查找 = [!^t^13]@: 替换 = ^& 并将替换颜色设置为红色。当然，您可以将其实现为宏，但我不明白为什么有人会打扰...

Answer 2

下面的代码将应用您需要的颜色。要将 TOC 大写，您应该将 TOC 样式的字体修改为 AllCaps

Sub ColorTOC()
   Dim tocRange As Range

   With ActiveDocument

      If .TablesOfContents.Count = 0 Then
         MsgBox "Aucune table des matières dans le document !", vbInformation
      Else
         With .TablesOfContents(1)
            Set tocRange = .Range.Duplicate
            tocRange.Collapse wdCollapseStart
            Do Until tocRange.End = .Range.End
               tocRange.MoveEndUntil ":"
               tocRange.MoveEnd wdCharacter, 1
               With tocRange
                  If .Text <> Chr(9) Then
                     .Font.ColorIndex = wdRed
                  End If
               End With
               tocRange.Collapse wdCollapseEnd
               tocRange.MoveUntil vbCr
               tocRange.Move wdCharacter, 1
            Loop
         End With
      End If
   End With
End Sub

更新目录时，会显示下面的对话框。

选择第一个选项不会导致格式丢失，但目录将不包含任何新添加的标题。第二个选项将包括任何新添加的标题，但它也会删除格式。

如果文档设置了“打印前更新字段”选项（应确保页码等正确），则会提示用户更新目录。这将在打印和导出为 PDF 之前发生。为确保您的目录具有正确的格式，您需要编写代码来响应 DocumentBeforePrint 事件，以便您可以重新应用格式。

MS WORD TOC : 如何在标题中的字符“:”之前或之后添加不同的颜色？

MS WORD TOC : How to put a different color before or after the character ":" in the titles?

vba

ms-word

tableofcontents