问题
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
回答1:
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
回答2:
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
回答3:
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
来源：https://stackoverflow.com/questions/57776654/powerpoint-vba-passing-rgb-colors-as-a-variable