如何通过VBA访问PowerPoint自定义颜色并生成彩色十六进制值表格

一、获取自定义主题颜色 #

通过XML注入的自定义颜色会存储在演示文稿的主题配色方案中，可直接通过Theme.ThemeColorScheme对象访问。以下是核心工具函数：

' 将RGB值转换为不带#的十六进制字符串
Function RGBToHex(rgbVal As Long) As String
    RGBToHex = Right("000000" & Hex(rgbVal), 6)
End Function

' 获取指定索引的主题颜色RGB值
Function GetCustomThemeColor(themeColorIndex As MsoThemeColorIndex) As Long
    GetCustomThemeColor = ActivePresentation.Theme.ThemeColorScheme.Colors(themeColorIndex).RGB
End Function

二、生成彩色表格的完整代码 #

运行以下代码会在当前幻灯片插入表格，自动填充自定义颜色并标注对应十六进制值：

Sub GenerateCustomColorTable()
    Dim sld As Slide
    Dim tbl As Table
    Dim i As Integer
    Dim startIndex As Integer, endIndex As Integer
    Dim rgbVal As Long
    Dim hexVal As String
    
    ' 根据你实际添加的自定义颜色数量调整索引范围
    startIndex = msoThemeColor1
    endIndex = msoThemeColor16 ' 示例：假设共16个自定义颜色
    
    ' 定位目标幻灯片（优先选中的幻灯片，无选中则取第一张）
    If ActiveWindow.View.Slide Is Nothing Then
        Set sld = ActivePresentation.Slides(1)
    Else
        Set sld = ActiveWindow.View.Slide
    End If
    
    ' 插入表格：行=颜色数量，列=2（颜色预览+十六进制值）
    Set tbl = sld.Shapes.AddTable( _
        NumRows:=endIndex - startIndex + 1, NumColumns:=2, _
        Left:=100, Top:=100, Width:=400, Height:=20 * (endIndex - startIndex + 1) _
    ).Table
    
    ' 配置表格基础样式
    With tbl
        .Columns(1).Width = 100
        .Columns(2).Width = 300
        ' 设置表头
        .Cell(1, 1).Shape.TextFrame.TextRange.Text = "颜色预览"
        .Cell(1, 2).Shape.TextFrame.TextRange.Text = "十六进制值"
        .Cell(1, 1).Shape.TextFrame.TextRange.Font.Bold = True
        .Cell(1, 2).Shape.TextFrame.TextRange.Font.Bold = True
    End With
    
    ' 遍历填充颜色与值
    For i = startIndex To endIndex
        rgbVal = GetCustomThemeColor(i)
        hexVal = "#" & RGBToHex(rgbVal)
        
        ' 填充单元格背景色
        tbl.Cell(i - startIndex + 2, 1).Shape.Fill.ForeColor.RGB = rgbVal
        ' 写入十六进制值
        tbl.Cell(i - startIndex + 2, 2).Shape.TextFrame.TextRange.Text = hexVal
        
        ' 自动调整文字颜色（背景浅用黑，背景深用白，保证可读性）
        If (rgbVal And &HFF) * 0.299 + ((rgbVal And &HFF00) \ &H100) * 0.587 + ((rgbVal And &HFF0000) \ &H10000) * 0.114 > 127 Then
            tbl.Cell(i - startIndex + 2, 2).Shape.TextFrame.TextRange.Font.Color.RGB = &H0
        Else
            tbl.Cell(i - startIndex + 2, 2).Shape.TextFrame.TextRange.Font.Color.RGB = &HFFFFFF
        End If
    Next i
End Sub

三、关键注意事项 #

• 务必根据实际添加的自定义颜色数量调整startIndex和endIndex，比如仅添加了4个额外颜色，可设置为msoThemeColor9到msoThemeColor12
• 代码会自动处理文字与背景的对比度，避免因颜色过深/过浅导致文字不可读
• 运行前需确保演示文稿已通过XML方法成功注入自定义主题颜色

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