【问题标题】:Show color picker for user to choose from in VBA powerpoint在 VBA PowerPoint 中显示颜色选择器供用户选择
【发布时间】:2019-06-28 02:24:39
【问题描述】:

我正在开发一个用于 powerpoint 的插件,我需要使用它来提供给定的颜色 - 最好是 RGB 术语。 VBA 中有没有办法显示颜色选择器?

【问题讨论】:

  • 正如 Dietrich Baumgarten 对 Steve G.'s question 的回答中关于如何在 Word、64 位 PowerPoint 中使用颜色选择器一样,需要 CHOOSECOLOR 类型的另一种结构。

标签: vba colors powerpoint


【解决方案1】:

Excel 中获取调色板颜色很容易。这会根据调色板中选择的颜色更改工作表 1 中单元格的背景:

Sub TestMe()

    Dim rgbSet As Variant: rgbSet = Application.Dialogs(xlDialogEditColor).Show(1)
    If rgbSet Then Worksheets(1).Cells.Interior.Color = ThisWorkbook.Colors(1)

End Sub

PowerPoint(和其他 VBA 托管应用程序)中,任务需要外部 dll:

Option Explicit

Private Declare Function ChooseColor_Dlg Lib "comdlg32.dll" _
    Alias "ChooseColorA" (pcc As CHOOSECOLOR_TYPE) As Long   

Private Type CHOOSECOLOR_TYPE
    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

Private Const CC_ANYCOLOR = &H100
Private Const CC_ENABLEHOOK = &H10
Private Const CC_ENABLETEMPLATE = &H20
Private Const CC_ENABLETEMPLATEHANDLE = &H40
Private Const CC_FULLOPEN = &H2
Private Const CC_PREVENTFULLOPEN = &H4
Private Const CC_RGBINIT = &H1
Private Const CC_SHOWHELP = &H8
Private Const CC_SOLIDCOLOR = &H80

在同一个模块中,编写代码:

Private Sub TestMe()

    Dim CC_T As CHOOSECOLOR_TYPE, Retval As Variant
    Static BDF(16) As Long
    BDF(0) = RGB(0, 255, 0)     'first defined color
    BDF(1) = RGB(255, 0, 0)     'second defined color
    BDF(2) = RGB(0, 0, 255)     'third defined color 

    With CC_T
        .lStructSize = Len(CC_T)
        .flags = CC_RGBINIT Or CC_ANYCOLOR Or CC_FULLOPEN Or _
        CC_PREVENTFULLOPEN
        .rgbResult = RGB(0, 255, 0)
        .lpCustColors = VarPtr(BDF(0))
    End With

    Retval = ChooseColor_Dlg(CC_T)

    If Retval <> 0 Then
        Dim labelObj As Object
        Set labelObj = ActivePresentation.Slides(1).Shapes.AddLine(100, 100, 200, 200).Line
        With labelObj
            .Weight = 25
            .ForeColor.RGB = CC_T.rgbResult
        End With
    End If

End Sub

这是最终的结果:

With credits to vbarchiv.net.

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2020-02-12
    • 1970-01-01
    相关资源
    最近更新 更多