Powerpoint VBA - 将 RGB 颜色作为变量传递答案

【问题标题】：Powerpoint VBA - Passing RGB colors as a variablePowerpoint VBA - 将 RGB 颜色作为变量传递
【发布时间】：2019-09-03 17:57:50
【问题描述】：

我希望允许用户通过文本框输入 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

【问题讨论】：

RGB() 函数不能像第一个循环中的字符串那样使用。此外，您不能将字符串传递给 RGB() 函数，因为它需要 3 个整数。最好的办法是制作 3 个用户可以更改的整数变量，然后将其传递给 RGB() 函数。
RGB 颜色是Long（最好用十六进制文字表示，例如&H00FFDD），而不是String...
感谢您的回复。我接受了 TheJeebo 的建议，为每个 RGB 创建了一个变量，并分别传递了每个变量。

标签： vba variables powerpoint rgb

【解决方案1】：

如何使用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

【讨论】：

您好 ComputerVersteher，感谢您的回复。我尝试了您的回复，因为理想情况下，如果它有效，那将是最理想的解决方案，但似乎什么都没有发生。我粘贴了上面的代码并更新了我的点击按钮以现在使用您的脚本，但现在什么也没有发生。是否应该提示我使用您的脚本为主要和次要选择颜色？
是的，对话框应该出现两次。确定代码已执行（通过断点或 Msgbox 检查）？代码编译（Vba -> 调试 -> 编译 VBAProject）？ Office 版本和位数？
您好 ComputerVersteher，感谢您的回复，感谢您的耐心等待。我试图对 ColorPickerDialog 进行 msgbox 并返回一个数字。我假设该数字是函数中设置的默认颜色。它不会提示我选择颜色。在office版本方面，我使用的是PowerPoint 365。
比特？如果是 x64，请在此处尝试示例 stackoverflow.com/a/54957092/9439330。
A common pitfall - The size of user-defined types（最后）。尝试编辑代码（Len 到 LenB）。

【解决方案2】：

正如其他人所建议的，RGB 定义不能由字符串提供。

如何创建一个自定义类型“颜色”并使用它在任何你需要的地方传递颜色。

如果您要使用它，请不要忘记将自定义类型定义块（类型颜色）放在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】：

我得到了这个工作，我通常使用 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

【讨论】：