Показывать палитру цветов для выбора пользователем в VBA powerpoint

Question

Я работаю над надстройкой для PowerPoint, где мне нужно использовать для предоставления определенного цвета - предпочтительно в терминах RGB.Есть ли способ в VBA для отображения палитры цветов?

Answer 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

И это конечный результат:

С кредитами для vbarchiv.net .