2

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

3 回答 3

1

正如其他人所建议的那样，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
于 2019-09-03T19:29:48.297 回答
1

怎么样使用windows 颜色选择器。

标准模块中的代码：

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
于 2019-09-03T21:26:41.287 回答
0

我得到了这个工作，我通常使用 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
于 2019-09-03T19:23:49.237 回答