Excel VBAでカラーダイアログを表示する｜Windows APIを使用

Option Explicit

Private Type COLORSTRUC
  lStructSize As Long
  hwnd As Long
  hInstance As Long
  rgbResult As Long
  lpCustColors As String
  flags As Long
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Const CC_SOLIDCOLOR = &H80

'カラーダイアログAPI
Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" _
  (pChoosecolor As COLORSTRUC) As Long

'ウィンドウハンドルを取得するAPI
Private Declare Function FindWindow Lib "user32" _
       Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Function ExColorDialog(hwnd As Long, lcol As Long) As Boolean
    Dim ln As Long
    Dim COLS As COLORSTRUC

    COLS.lStructSize = Len(COLS)
    COLS.rgbResult = RGB(255, 255, 255)
    COLS.hwnd = hwnd
    COLS.flags = CC_SOLIDCOLOR
    COLS.lpCustColors = String$(16 * 4, 0)
    ln = ChooseColor(COLS)
    If ln = 0 Then  'Cancel
        lcol = RGB(255, 255, 255)
        ExColorDialog = False
        Exit Function
    Else    'OK
        lcol = COLS.rgbResult
    End If
    ExColorDialog = True
End Function


Private Sub CommandButton1_Click()
    Dim ln As Long
    Dim ret As Boolean
    Dim hwnd As Long
    
    ln = CommandButton1.ForeColor
    'Excelのハンドルを取得
    hwnd = FindWindow("XLMAIN", Application.Caption)
    'カラーダイアログを開く
    ret = ExColorDialog(hwnd, ln)
    If ret Then
        'フォント色をセット
        CommandButton1.ForeColor = ln
    End If
End Sub