在 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.