如何通过VB正确提取Word标题的RGB/HEX字体颜色？

问题根源 #

你遇到的颜色值为负数、RGB转换错误的问题，核心原因是：

• Word的Font.Color返回的是OLE_COLOR类型（带符号32位长整型），负数代表主题色、系统色或非标准RGB颜色空间，直接用普通的Mod/整除运算会被符号位干扰，导致计算出错误的RGB分量。
• 第二段代码中Font.ColorIndex返回的是Word内置颜色的枚举索引（比如wdWhite对应2），并非实际的RGB数值，所以无法得到正确的颜色值。

解决方案 #

方法1：使用Windows API提取RGB分量

通过Windows API的GetRValue、GetGValue、GetBValue函数，可以正确解析带符号的OLE_COLOR值：

' 必须放在模块的最顶部（所有Sub/Function之前）
Declare PtrSafe Function GetRValue Lib "gdi32.dll" (ByVal rgb As Long) As Byte
Declare PtrSafe Function GetGValue Lib "gdi32.dll" (ByVal rgb As Long) As Byte
Declare PtrSafe Function GetBValue Lib "gdi32.dll" (ByVal rgb As Long) As Byte

Sub FindHeading1Properties_Fixed()
    Dim doc As Document
    Dim searchRange As Range
    Dim foundRange As Range
    Dim fontSize As Single ' 字体大小可能是小数，用Single更准确
    Dim fontColor As Long
    Dim fontName As String
    Dim newDoc As Document

    Set doc = ActiveDocument
    Set searchRange = doc.Content
    Set newDoc = Documents.Add

    With searchRange.Find
        .Text = "HEADING 1"
        .MatchCase = False
        .Execute
        If .Found Then
            Set foundRange = searchRange.Duplicate
            fontSize = foundRange.Font.Size
            fontColor = foundRange.Font.Color
            fontName = foundRange.Font.Name

            ' 用API正确提取RGB
            Dim red As Byte, green As Byte, blue As Byte
            red = GetRValue(fontColor)
            green = GetGValue(fontColor)
            blue = GetBValue(fontColor)

            newDoc.Content.InsertAfter "Font Name: " & fontName & vbCrLf
            newDoc.Content.InsertAfter "Font Size: " & fontSize & vbCrLf
            newDoc.Content.InsertAfter "RGB: (" & red & ", " & green & ", " & blue & ")" & vbCrLf
        Else
            MsgBox "未找到文本'HEADING 1'。"
        End If
    End With

    newDoc.Activate
    Selection.HomeKey Unit:=wdStory

    ' 释放对象
    Set doc = Nothing
    Set searchRange = Nothing
    Set foundRange = Nothing
    Set newDoc = Nothing
End Sub

方法2：直接针对"Heading 1"样式提取属性（更可靠）

不需要搜索文本，直接查找应用了"Heading 1"样式的段落，避免文本搜索的局限性：

Sub GetHeading1StyleProperties()
    Dim doc As Document
    Dim para As Paragraph
    Dim newDoc As Document
    Dim fontColor As Long
    Dim red As Byte, green As Byte, blue As Byte

    Set doc = ActiveDocument
    Set newDoc = Documents.Add

    ' 遍历所有段落，查找应用Heading 1样式的段落
    For Each para In doc.Paragraphs
        If para.Style = "Heading 1" Then
            ' 用API提取RGB
            fontColor = para.Range.Font.Color
            red = GetRValue(fontColor)
            green = GetGValue(fontColor)
            blue = GetBValue(fontColor)

            newDoc.Content.InsertAfter "Heading 1 字体属性:" & vbCrLf
            newDoc.Content.InsertAfter "字体名称: " & para.Range.Font.Name & vbCrLf
            newDoc.Content.InsertAfter "字体大小: " & para.Range.Font.Size & vbCrLf
            newDoc.Content.InsertAfter "RGB颜色: (" & red & ", " & green & ", " & blue & ")" & vbCrLf
            Exit For ' 只取第一个Heading 1，如需全部则去掉Exit For
        End If
    Next para

    newDoc.Activate
    Selection.HomeKey Unit:=wdStory

    Set doc = Nothing
    Set newDoc = Nothing
End Sub

关键说明 #

• 若使用64位Office，必须在API声明中加上PtrSafe关键字；32位Office可省略。
• 字体大小建议用Single类型，因为Word支持小数字号（比如11.5）。
• 如果标题使用的是主题色，Font.Color返回的是主题色的OLE_COLOR值，此时可以通过Font.ThemeColor获取主题色枚举，再转换为对应的RGB值（如需处理主题色可补充相关逻辑）。

内容的提问来源于stack exchange，提问作者Mark Pinsley