How to get the RGB/Long values from PowerPoint color palette

Question

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

The subroutine below will obtain 12 colors from the theme,

Answer 1

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

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).

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

updated to be pure PowerPoint code, with output shown at the end

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