Powerpoint VBA - 将 RGB 颜色作为变量传递 [英] Powerpoint VBA - Passing RGB colors as a variable

问题描述

我希望允许用户通过文本框输入 RGB 颜色并传递该变量以更改所有形状的颜色.我写了一个循环，它会查看形状名称的最后 2 个字符，以确定是否应该将其更改为主要颜色或辅助颜色.

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.

这是来自最新 Office 365 的 PowerPoint.

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

推荐答案

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

这篇关于Powerpoint VBA - 将 RGB 颜色作为变量传递的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！