Powerpoint VBA - Passing RGB colors as a variable

Question

I want to allow users to enter in a RGB color via a text box and pass that variable to change the colors of all shapes. I wrote a loop that would look at the last 2 characters of the shape name to determine if it should be changed to the primary or secondary color.

This is for powerpoint from the latest office 365.

I've tried the following codes. I am getting either an type mismatch or invalid argument error:

Dim osld As Slide
Dim oshp As Shape
Dim strMainColor As String, strSecondColor As String

'Set main color to default if users didn't enter a RGB value
If MainColor.Value = "" Then strMainColor = "73, 109, 164" Else strMainColor = MainColor.Value

'Set Secondary color to default if users didn't enter a RGB value
If SecondColor.Value = "" Then strSecondColor = "207, 203, 201" Else strSecondColor = SecondColor.Value

For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Right(oshp.Name, 2) = "_1" Then
   'Main Color to all slides
   oshp.Fill.ForeColor.RGB = "RGB(" + strMainColor + ")"
   oshp.Fill.BackColor.RGB = "RGB(" + strMainColor + ")"
   ElseIf Right(oshp.Name, 2) = "_2" Then
    'Secondary Colors
    oshp.Fill.ForeColor.RGB = "RGB(" + strSecondColor + ")"
    oshp.Fill.BackColor.RGB = "RGB(" + strSecondColor + ")"
End If
Next oshp
Next osld



Dim osld As Slide
Dim oshp As Shape
Dim strMainColor As String, strSecondColor As String

'Set main color to default if users didn't enter a RGB value
If MainColor.Value = "" Then strMainColor = "73, 109, 164" Else strMainColor = MainColor.Value

'Set Secondary color to default if users didn't enter a RGB value
If SecondColor.Value = "" Then strSecondColor = "207, 203, 201" Else strSecondColor = SecondColor.Value

For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Right(oshp.Name, 2) = "_1" Then
   'Main Color to all slides
   oshp.Fill.ForeColor.RGB = RGB(strMainColor)
   oshp.Fill.BackColor.RGB = RGB(strMainColor)
   ElseIf Right(oshp.Name, 2) = "_2" Then
    'Secondary Colors
    oshp.Fill.ForeColor.RGB = RGB(strSecondColor)
    oshp.Fill.BackColor.RGB = RGB(strSecondColor)
End If
Next oshp
Next osld

The RGB() function can't be used like a string like in the first loop. Additionally, you can't pass a string into the RGB() function as it requires 3 Integers. Your best bet is to make 3 integer variables that the user can change that are then passed into the RGB() function. — TheJeebo, Sep 03 '19 at 18:22
RGB color is a `Long` (best represented with a hex literal e.g. `&H00FFDD`), not a `String`... — Mathieu Guindon, Sep 03 '19 at 18:36
Thanks for the response. I took TheJeebo advice and created a variable for each RGB and passed each separately. — Dave, Sep 03 '19 at 20:54

score 1 · Answer 1 · answered Sep 03 '19 at 19:29

As others have suggested RGB definition cannot be fed by strings.

How about creating a Custom Type "Color" and use that to pass on the colour wherever you need it.

If you are going to use this don't forget to put the Custom Type Definition block (Type Color) before the line Sub Test()

Option Explicit

Type Color
    R As Integer
    G As Integer
    B As Integer
End Type

Sub Test()

    Dim osld As Slide
    Dim oshp As Shape
    Dim MainColor As Color
    Dim SecondColor As Color

    'Set main color to default if users didn't enter a RGB value
    With MainColor
        If .R = 0 And .G = 0 And .B = 0 Then
            .R = 73
            .G = 109
            .B = 164
        End If
    End With

    'Set Secondary color to default if users didn't enter a RGB value
    With SecondColor
        If .R = 0 And .G = 0 And .B = 0 Then
            .R = 207
            .G = 203
            .B = 201
        End If
    End With


    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If Right(oshp.Name, 2) = "_1" Then
               'Main Color to all slides
                oshp.Fill.ForeColor.RGB = RGB(MainColor.R, MainColor.G, MainColor.B)
                oshp.Fill.BackColor.RGB = RGB(MainColor.R, MainColor.G, MainColor.B)
            ElseIf Right(oshp.Name, 2) = "_2" Then
                'Secondary Colors
                oshp.Fill.ForeColor.RGB = RGB(SecondColor.R, SecondColor.G, SecondColor.B)
                oshp.Fill.BackColor.RGB = RGB(SecondColor.R, SecondColor.G, SecondColor.B)
            End If
        Next oshp
    Next osld

End Sub

ComputerVersteher · Accepted Answer · 2019-11-06T00:12:31.173

What about using the windows color picker.

Code in standard module:

Option Explicit

Private Const CC_FULLOPEN = &H2
Private dwCustClrs(0 To 15) As Long

#If VBA7 Then
    Private Type COLORSTRUC
      lStructSize As Long
      hwndOwner As LongPtr
      hInstance As LongPtr
      rgbResult As Long
      lpCustColors As LongPtr
      flags As Long
      lCustData As LongPtr
      lpfnHook As LongPtr
      lpTemplateName As String
    End Type
#Else
    Private Type COLORSTRUC
      lStructSize As Long
      hwndOwner As Long
      hInstance As Long
      rgbResult As Long
      lpCustColors As Long
      flags As Long
      lCustData As Long
      lpfnHook As Long
      lpTemplateName As String
    End Type
#End If

#If VBA7 Then
    Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As COLORSTRUC) As Long
#Else
    Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As COLORSTRUC) As Long
#End If

Private Sub SetCustomColors() 'Define custom colors of picker here.
    dwCustClrs(0) = vbBlack
    dwCustClrs(1) = vbWhite
    dwCustClrs(2) = vbRed
    dwCustClrs(4) = vbGreen
    dwCustClrs(5) = vbBlue
    dwCustClrs(6) = RGB(0, 0, 0)
    dwCustClrs(7) = vbBlack
    dwCustClrs(8) = vbBlack
    dwCustClrs(9) = vbBlack
    dwCustClrs(10) = vbBlack
    dwCustClrs(11) = vbBlack
    dwCustClrs(12) = vbBlack
    dwCustClrs(13) = vbBlack
    dwCustClrs(14) = vbBlack
    dwCustClrs(15) = vbBlack
End Sub

Public Function ColorPickerDialog(Optional DefaultColor As Long = vbWhite) As Long
  Dim x As Long, CS As COLORSTRUC
  SetCustomColors 'Comment out if all custom colors should be black
  CS.lStructSize = LenB(CS) ' not Len, see https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit at end
  CS.flags = CC_FULLOPEN
  CS.lpCustColors = VarPtr(dwCustClrs(0))
  x = CHOOSECOLOR(CS)
  If x = 0 Then
    ColorPickerDialog = DefaultColor
    Exit Function
  Else
    ColorPickerDialog = CS.rgbResult
  End If
End Function

Set shapes:

Dim osld As Slide
Dim oshp As Shape
Dim MainColor As Long, SecondColor As Long

'Chose MainColor
MainColor = ColorPickerDialog(RGB(73, 109, 164)) ' if no color choosen the default color RGB(73, 109, 164) is used

'Choose SecondColors
SecondColor = ColorPickerDialog(RGB(207, 203, 201))


For Each osld In ActivePresentation.Slides
    For Each oshp In osld.Shapes
        With oshp
            If Right(.Name, 2) = "_1" Then
               'Main Color to all slides
               .Fill.ForeColor.RGB = MainColor
               .Fill.BackColor.RGB = MainColor 
             ElseIf Right(.Name, 2) = "_2" Then
                'Secondary Colors
                .Fill.ForeColor.RGB = SecondColor
                .Fill.BackColor.RGB = SecondColor
            End If
        End With
    Next oshp
Next osld

Hi ComputerVersteher, thank you for your response. I tried your response since ideally that would be the best ideal solution if it worked, but nothing seems to be happening. I pasted the code above and updated my on click button to now use your scripts, but nothing happens now. Should I have been prompted to select a color for both main and second using your script? — Dave, Nov 04 '19 at 18:42
Yes the dialog should appear two times. Sure code is executed (check by breakpoint or Msgbox)? Code compiles (Vba -> Debug -> Compile VBAProject)? Office Version and Bitness? — ComputerVersteher, Nov 04 '19 at 19:48
Hi ComputerVersteher, thank you for your response and i appreciate your patience. I tried to msgbox the ColorPickerDialog and it returned a number. I'm assuming that number was the default color set in the function. It doesn't prompt me to select a color. In terms of office version, I'm using PowerPoint 365. — Dave, Nov 05 '19 at 20:34
Bitness? If x64, try example here https://stackoverflow.com/a/54957092/9439330. — ComputerVersteher, Nov 05 '19 at 23:13
[A common pitfall - The size of user-defined types](https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit)(at end). Try edited code (Len to LenB). — ComputerVersteher, Nov 06 '19 at 00:11
Thank you ComputerVersteher, the LenB change worked. You rock! — Dave, Nov 06 '19 at 18:53

score 0 · Answer 3 · answered Sep 03 '19 at 19:23

I got this to work, I usually work with Excel so there may be a better way to do this. Also, I would recommend some error trapping in case the user doesn't enter in the number in the right format "#, #, #". But this will essentially take the string of your default color or the color the user has entered in, split it into 3 parts and then pass it to the RGB() function.

Dim osld As Slide
Dim oshp As Shape
Dim strMainColor As String, strSecondColor As String
'these are new
Dim MainInt As Variant, SecondInt As Variant

'Set main color to default if users didn't enter a RGB value
If MainColor.Value = "" Then
    strMainColor = "73, 109, 164"
    MainInt = Split(strMainColor, ",")
Else
    strMainColor = MainColor.Value
    MainInt = Split(strMainColor, ",")
End If

'Set Secondary color to default if users didn't enter a RGB value
If SecondColor.Value = "" Then
    strSecondColor = "207, 203, 201"
    SecondInt = Split(strSecondColor, ",")
Else
    strSecondColor = SecondColor.Value
    SecondInt = Split(strSecondColor, ",")
End If

For Each osld In ActivePresentation.Slides
For Each oshp In osld.Shapes
If Right(oshp.Name, 2) = "_1" Then
   'Main Color to all slides
   oshp.Fill.ForeColor.RGB = RGB(MainInt(0), MainInt(1), MainInt(2))
   oshp.Fill.BackColor.RGB = RGB(MainInt(0), MainInt(1), MainInt(2))
   ElseIf Right(oshp.Name, 2) = "_2" Then
    'Secondary Colors
    oshp.Fill.ForeColor.RGB = RGB(SecondInt(0), SecondInt(1), SecondInt(2))
    oshp.Fill.BackColor.RGB = RGB(SecondInt(0), SecondInt(1), SecondInt(2))
End If
Next oshp
Next osld

Powerpoint VBA - Passing RGB colors as a variable

3 Answers3

Linked