如何从PowerPoint调色板获取RGB / Long值 [英] How to get the RGB/Long values from PowerPoint color palette

问题描述

我正在尝试（大部分成功）从活动的 ThemeColorScheme 中读取颜色。

I am trying (mostly successfully) to "read" the colors from the active ThemeColorScheme.

下面的子例程将从主题获取12种颜色，例如，这是 myAccent1 ：

The subroutine below will obtain 12 colors from the theme, for example this is myAccent1:

我还需要从调色板中获得4种以上的颜色。我需要的四种颜色将是紧挨着上面指示的颜色的一种颜色，然后是从左到右的下三种颜色。

I need also to obtain 4 more colors from the palette. The four colors I need will be the one immediately below the color indicated above, and then the next 3 colors from left-to-right.

因为 ThemeColorScheme 对象仅包含12个项目，我得到指定的值超出范围错误，如果我尝试将值分配给 myAccent9 这样。我了解此错误以及发生原因。我不知道如何访问调色板中的其他40多种颜色，这些颜色不是 ThemeColorScheme 对象的一部分？

Because the ThemeColorScheme object holds 12 items only I get The specified value is out of range error, as expected if I try to assign a value to myAccent9 this way. I understand this error and why it occurs. What I do not know is how to access the other 40-odd colors from the palette, which are not part of the ThemeColorScheme object?

Private Sub ColorOverride()

Dim pres As Presentation
Dim thm As OfficeTheme
Dim themeColor As themeColor
Dim schemeColors As ThemeColorScheme

Set pres = ActivePresentation

Set schemeColors = pres.Designs(1).SlideMaster.Theme.ThemeColorScheme

    myDark1 = schemeColors(1).RGB         'msoThemeColorDark1
    myLight1 = schemeColors(2).RGB        'msoThemeColorLight
    myDark2 = schemeColors(3).RGB         'msoThemeColorDark2
    myLight2 = schemeColors(4).RGB        'msoThemeColorLight2
    myAccent1 = schemeColors(5).RGB       'msoThemeColorAccent1
    myAccent2 = schemeColors(6).RGB       'msoThemeColorAccent2
    myAccent3 = schemeColors(7).RGB       'msoThemeColorAccent3
    myAccent4 = schemeColors(8).RGB       'msoThemeColorAccent4
    myAccent5 = schemeColors(9).RGB       'msoThemeColorAccent5
    myAccent6 = schemeColors(10).RGB      'msoThemeColorAccent6
    myAccent7 = schemeColors(11).RGB      'msoThemeColorThemeHyperlink
    myAccent8 = schemeColors(12).RGB      'msoThemeColorFollowedHyperlink

    '## THESE LINES RAISE AN ERROR, AS EXPECTED:

    'myAccent9 = schemeColors(13).RGB     
    'myAccent10 = schemeColors(14).RGB
    'myAccent11 = schemeColors(15).RGB
    'myAccent12 = schemeColors(16).RGB

End Sub

所以我的问题是我可以从调色板/主题中获得这些颜色的RGB值吗？

So my question is, how might I obtain the RGB value of these colors from the palette/theme?

推荐答案

如果将VBA用于excel，则可以记录您的击键。选择另一种颜色（从主题下方）显示：

If you use VBA for excel, you can record your keystrokes. Selecting another color (from below the theme) shows:

    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorLight2
    .TintAndShade = 0.599993896298105
    .PatternTintAndShade = 0

.TintAndShade 因子修改定义的颜色。主题中的不同颜色对 .TintAndShade 使用不同的值-有时数字为负（使浅色变暗）。

The .TintAndShade factor modifies the defined color. Different colors in the theme use different values for .TintAndShade - sometimes the numbers are negative (to make light colors darker).

.TintAndShade 的不完整表格（对于我恰好在Excel中使用的主题，前两种颜色）：

Incomplete table of .TintAndShade (for the theme I happened to have in Excel, first two colors):

 0.00  0.00
-0.05  0.50
-0.15  0.35
-0.25  0.25
-0.35  0.15
-0.50  0.05

编辑一些或多或少进行转换的代码-您需要确保在阴影中具有正确的值，否则颜色的转换似乎可以工作

EDIT some code that "more or less" does the conversion - you need to make sure that you have the right values in your shades, but otherwise the conversion of colors seems to work

已更新为纯PowerPoint代码，并在末尾显示了输出

Option Explicit

Sub calcColor()
Dim ii As Integer, jj As Integer
Dim pres As Presentation
Dim thm As OfficeTheme
Dim themeColor As themeColor
Dim schemeColors As ThemeColorScheme
Dim shade
Dim shades(12) As Variant
Dim c, c2 As Long
Dim newShape As Shape

Set pres = ActivePresentation
Set schemeColors = pres.Designs(1).SlideMaster.Theme.ThemeColorScheme
shades(0) = Array(0, -0.05, -0.15, -0.25, -0.35, -0.5)
shades(1) = Array(0, 0.05, 0.15, 0.25, 0.35, 0.5)
shades(2) = Array(-0.1, -0.25, -0.5, -0.75, -0.9)
For ii = 3 To 11
  shades(ii) = Array(-0.8, -0.6, -0.4, 0.25, 0.5)
Next

For ii = 0 To 11
  c = schemeColors(ii + 1).RGB
  For jj = 0 To 4
    c2 = fadeRGB(c, shades(ii)(jj))
    Set newShape = pres.Slides(1).Shapes.AddShape(msoShapeRectangle, 200 + 30 * ii, 200 + 30 * jj, 25, 25)
    newShape.Fill.BackColor.RGB = c2
    newShape.Fill.ForeColor.RGB = c2
    newShape.Line.ForeColor.RGB = 0
    newShape.Line.BackColor.RGB = 0
  Next jj
Next ii

End Sub

Function fadeRGB(ByVal c, s) As Long
Dim r, ii
r = toRGB(c)
For ii = 0 To 2
  If s < 0 Then
    r(ii) = Int((r(ii) - 255) * s + r(ii))
  Else
    r(ii) = Int(r(ii) * (1 - s))
  End If
Next ii
fadeRGB = r(0) + 256& * (r(1) + 256& * r(2))

End Function

Function toRGB(c)
Dim retval(3), ii

For ii = 0 To 2
  retval(ii) = c Mod 256
  c = (c - retval(ii)) / 256
Next

toRGB = retval

End Function

这篇关于如何从PowerPoint调色板获取RGB / Long值的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！