如何从PowerPoint调色板中获取RGB / Long值

Question

我正在尝试（主要是成功）从活跃的ThemeColorScheme“读取”颜色。

下面的子程序将从主题中获得12种颜色，例如myAccent1：

我还需要从调色板中再获取4种颜色。我需要的四种颜色是紧接上面指示颜色的颜色，然后是从左到右的下三种颜色。

因为ThemeColorScheme对象仅包含12个项目，所以我会出现The specified value is out of range错误，如果我尝试以这种方式将值分配给myAccent9，则会出现错误。我理解这个错误及其发生的原因。我不知道的是如何从调色板访问其他40多种颜色，这些颜色不属于ThemeColorScheme对象的一部分？

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值？

Answer 1

乍一看Floris' solution似乎有效，但如果您关注准确性，您很快就会意识到之前的解决方案仅适用于办公室颜色计算，仅适用于色彩空间的一小部分。

正确的解决方案 - 使用HSL色彩空间

Office在计算着色和着色时似乎使用HSL color模式，使用此技术可以为我们提供几乎100％准确的颜色计算（在Office 2013上测试）。

正确计算数值的方法似乎是：

1. 将基本RGB颜色转换为HSL
2. 找到用于五种子颜色的色调和阴影值
3. 应用色调/阴影值
4. 从HSL转换回RGB色彩空间

要查找色调/阴影值（步骤＃3），请查看HSL颜色的亮度值并使用此表（通过试验和错误找到）：

| [0.0] | <0.0 - 0.2> | [0.2 - 0.8] | <0.8 - 1.0> | [1.0] |
|:-----:|:-----------:|:-----------:|:-----------:|:-----:|
| + .50 |    + .90    |    + .80    |    - .10    | - .05 |
| + .35 |    + .75    |    + .60    |    - .25    | - .15 |
| + .25 |    + .50    |    + .40    |    - .50    | - .25 |
| + .10 |    + .25    |    - .25    |    - .75    | - .35 |
| + .05 |    + .10    |    - .50    |    - .90    | - .50 |

正值是着色（使其变浅），负值是着色（使其变暗）。有五组; 1组为完全黑色，1组为完全白色。这些只会匹配这些特定值（而不是RGB = {255, 255, _254_}）。然后有两个小范围的非常暗和非常浅的颜色，分别处理，最后是所有其他颜色的大范围。

注意：值+0.40意味着该值将减轻40％，而不是原始颜色的40％（这实际上意味着它减轻了60％）。这可能会使某些人感到困惑，但这是Office在内部使用这些值的方式（即在Excel中通过TintAndShade的{​​{1}}属性）。

用于实施解决方案的PowerPoint VBA代码

[免责声明]：我建立在Floris创建此VBA的解决方案之上。许多HSL翻译代码也已从Word article mentioned in the comments已经复制。

以下代码的输出是以下颜色变化：



乍一看，这与Floris的解决方案非常相似，但仔细观察后，您可以清楚地看到许多情况下的差异。办公室主题颜色（因此这个解决方案）通常比普通的RGB淡化/暗化技术更加饱和。



Cell.Interior

Answer 2

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

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

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

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

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

编辑某些代码“或多或少”进行转换 - 您需要确保在shades中拥有正确的值，否则转换颜色似乎工作

更新为纯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

Answer 3

基于上述具有HSL值的解决方案，在此处添加了可在Excel中运行的演示。与上面列出的HSL解决方案一起使用。

Sub DemoExcelThemecolorsHSL()
   Dim rng As Range
   Dim n As Integer, m As Integer
   Dim arrNames
   Dim arrDescriptions
   Dim arrValues
   Dim schemeColors As ThemeColorScheme
   Dim dblTintShade As Double
   Dim lngColorRGB As Long, lngColorRGBshaded As Long
   Dim ColorHSL As HSL, ColorHSLshaded As HSL

   Set schemeColors = ActiveWorkbook.Theme.ThemeColorScheme

   arrNames = Array("xlThemeColorDark1", "xlThemeColorLight1", "xlThemeColorDark2", "xlThemeColorLight2", "xlThemeColorAccent1", "xlThemeColorAccent2", _
                    "xlThemeColorAccent3", "xlThemeColorAccent4", "xlThemeColorAccent5", "xlThemeColorAccent6", "xlThemeColorHyperlink", "xlThemeColorFollowedHyperlink")
   arrDescriptions = Array("Dark1", "Light1", "Dark2", "Light2", "Accent1", "Accent2", "Accent3", "Accent4", "Accent5", "Accent6", "Hyperlink", "Followed hyperlink")
   arrValues = Array(2, 1, 4, 3, 5, 6, 7, 8, 9, 10, 11, 12)

   ' New sheet, title row
   ActiveWorkbook.Worksheets.Add
   Set rng = Cells(1, 2)
   rng(1, 1).Value2 = "ThemeColor Name"
   rng(1, 2).Value2 = "Value"
   rng(1, 3).Value2 = "Description"
   rng(1, 4).Value2 = "TintAndShade"
   rng.Resize(1, 4).Font.Bold = True

   Set rng = rng(3, 1)
   ' color matrix
   For n = 0 To 11
      rng(n * 2, 1).Value = arrNames(n)
      rng(n * 2, 2).Value = arrValues(n)
      rng(n * 2, 3).Value = arrDescriptions(n)

      lngColorRGB = schemeColors(n + 1).RGB
      For m = 0 To 5
         ColorHSL = RGBtoHSL(lngColorRGB)
         dblTintShade = SelectTintOrShade(ColorHSL, m)
         ColorHSLshaded = ApplyTintAndShade(ColorHSL, dblTintShade)
         lngColorRGBshaded = HSLtoRGB(ColorHSLshaded)

         With rng(n * 2, m + 4)
            .Value = dblTintShade
            If ColorHSLshaded.L < 0.5 Then .Font.ColorIndex = 2

            ' fixed color, not changing when a new Color scheme is being selected
            .Interior.color = lngColorRGBshaded

            ' cell color dependent on selected color palette
            .Offset(1, 0).Interior.ThemeColor = arrValues(n)
            .Offset(1, 0).Interior.TintAndShade = dblTintShade

         End With
      Next m
   Next n
   rng.Resize(1, 3).EntireColumn.AutoFit

End Sub