Powerpoint VBA - 将 RGB 颜色作为变量传递
Powerpoint VBA - Passing RGB colors as a variable
我想允许用户通过文本框输入 RGB 颜色并传递该变量以更改所有形状的颜色。我写了一个循环，它会查看形状名称的最后 2 个字符，以确定是否应将其更改为主要颜色或次要颜色。
这是最新版 office 365 的 powerpoint。
我试过以下代码。我收到类型不匹配或无效参数错误：
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
我得到了这个工作，我通常使用 Excel 所以可能有更好的方法来做到这一点。另外，如果用户没有以正确的格式“#、#、#”输入数字，我会建议进行一些错误捕获。但这实际上会将您的默认颜色或用户输入的颜色的字符串拆分为 3 部分，然后将其传递给 RGB() 函数。
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
正如其他人所建议的，RGB 定义不能由字符串提供。
如何创建一个自定义类型 "Color" 并使用它在您需要的任何地方传递颜色。
如果您要使用它，请不要忘记将自定义类型定义块（类型颜色）放在 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
使用 windows color picker 怎么样？
标准模块中的代码：
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
设置形状：
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
我想允许用户通过文本框输入 RGB 颜色并传递该变量以更改所有形状的颜色。我写了一个循环，它会查看形状名称的最后 2 个字符，以确定是否应将其更改为主要颜色或次要颜色。
这是最新版 office 365 的 powerpoint。
我试过以下代码。我收到类型不匹配或无效参数错误：
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
我得到了这个工作，我通常使用 Excel 所以可能有更好的方法来做到这一点。另外，如果用户没有以正确的格式“#、#、#”输入数字，我会建议进行一些错误捕获。但这实际上会将您的默认颜色或用户输入的颜色的字符串拆分为 3 部分，然后将其传递给 RGB() 函数。
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
正如其他人所建议的，RGB 定义不能由字符串提供。
如何创建一个自定义类型 "Color" 并使用它在您需要的任何地方传递颜色。
如果您要使用它，请不要忘记将自定义类型定义块（类型颜色）放在 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
使用 windows color picker 怎么样？
标准模块中的代码：
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
设置形状：
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