在VBA中调用调色板

Private Sub CommandButton1_Click()
'保存活动单元格当前字体格式设置
With ActiveCell.Font
x_name = .Name
x_fontstyle = .FontStyle
x_size = .Size
x_Strikethrough = .Strikethrough
x_Superscript = .Superscript
x_Subscript = .Subscript
x_OutlineFont = .OutlineFont
x_Shadow = .Shadow
x_Underline = .Underline
x_ColorIndex = .ColorIndex
End With
dlg = Application.Dialogs(xlDialogActiveCellFont).Show '调用活动单元格字体设置选项卡对话框
'************其他类似对话框*************
'Application.Dialogs(xlDialogFontProperties).Show
'Application.Dialogs(xlDialogFormatFont).Show
'Application.Dialogs(xlDialogFont).Show
'Application.Dialogs(xlDialogPatterns).Show '单元格底纹设置
'Application.Dialogs(xlDialogReplaceFont).Show '查找替换对话框中的字体设置
'Application.Dialogs(xlDialogStandardFont).Show
'************************************
If dlg = True Then
Application.ScreenUpdating = False
Me.Label1.ForeColor = ActiveCell.Font.Color
'恢复活动单元格原有字体格式设置
With ActiveCell.Font
.Name = x_name
.FontStyle = x_fontstyle
.Size = x_size
.Strikethrough = x_Strikethrough
.Superscript = x_Superscript
.Subscript = x_Subscript
.OutlineFont = x_OutlineFont
.Shadow = x_Shadow
.Underline = x_Underline
.ColorIndex = x_ColorIndex
End With
Application.ScreenUpdating = True
End If
End Sub

Private Sub CommandButton2_Click()
oldcolor = ActiveWorkbook.Colors(1) '保存活动工作簿中调色板第一格的当前颜色
If Application.Dialogs(xlDialogEditColor).Show(1) = True Then '调用编辑颜色对话框，选择的颜色将返回到调色板的第一格
'************其上一级对话框，但不太适合使用*************
'Application.Dialogs(xlDialogColorPalette).Show
'Application.Dialogs.Item(xlDialogColorPalette).Show
'*************************************************
Me.Label1.ForeColor = ActiveWorkbook.Colors(1)
ActiveWorkbook.Colors(1) = oldcolor '恢复活动工作簿调色板第一格的原有颜色
End If
End Sub

Private Type CHOOSECOLOR
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 Long
End Type
Private Type RGBColor
R As Byte
G As Byte
B As Byte
space As Byte '用作间隔
End Type
Private Declare Function ChooseColorA Lib "Comdlg32" (pChoosecolor As CHOOSECOLOR) As Long
Dim CustColors(1 To 16) As RGBColor
Private Sub CommandButton3_Click()
Dim CColor As CHOOSECOLOR
With CColor
.lStructSize = Len(CColor) '结构长度
.lpCustColors = VarPtr(CustColors(1)) '存储自定义颜色的缓冲区地址，CustColors为公共变量，用于保存自定义颜色，以便于用户下一次打开调色板时仍能够使用前一次的自定义颜色
End With
If ChooseColorA(CColor) = 0 Then Exit Sub '等于0表示按下了取消键
Me.Label1.ForeColor = CColor.rgbResult
End Sub

Private Sub CommandButton4_Click()
On Error GoTo zz
Me.CommonDialog1.CancelError = True
Me.CommonDialog1.ShowColor
Me.Label1.ForeColor = CommonDialog1.Color
Exit Sub
zz:
End Sub