カラーダイアログボックスを表示する（MS Office用・Win32API）

Win32APIを使ってVBAでカラーダイアログボックスを表示してみた。

Microsoft公式より

VBA用記述

VBA 7.x 用の記述 リファレンスのWin32API_PtrSafe.TXT内15426-15448行目より抜粋。

Type CHOOSECOLOR
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        rgbResult As Long
        lpCustColors As LongPtr
        flags As Long
        lCustData As LongPtr
        lpfnHook As LongPtr
        lpTemplateName As String
End Type
Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Const CC_RGBINIT = &H1
Const CC_FULLOPEN = &H2
Const CC_PREVENTFULLOPEN = &H4
Const CC_SHOWHELP = &H8
Const CC_ENABLEHOOK = &H10
Const CC_ENABLETEMPLATE = &H20
Const CC_ENABLETEMPLATEHANDLE = &H40
Const CC_SOLIDCOLOR = &H80
Const CC_ANYCOLOR = &H100

MSDN

API関数
[ChooseColor][ChooseColor]

構造体+定数（英語）
[CHOOSECOLOR structure][CHOOSECOLOR structure]

[ChooseColor]:https://msdn.microsoft.com/ja-jp/library/cc410660.aspx "ChooseColor"
[CHOOSECOLOR structure]:https://msdn.microsoft.com/ja-jp/library/ms646830.aspx "CHOOSECOLOR structure"

ラップしてみる

VBAでも扱いやすいようにラップしたShowColorDialog関数を作成した。

動作環境

VBA7以上（MSOfficeでは2010以降）必須。
Windows版 MSOffice 2013 32bit / MSOffice 2016 64bit で動作確認。

ラップしたコード

API_ColorDialog.bas

Option Explicit

'WinAPIChooseColor表示状態設定用フラグ
'普段使わなそうなものはコメントアウト
Public Enum CColor
    CC_RGBINIT = &H1                '開いたときに最も近い色を選択しておく。未指定では黒。
    CC_FULLOPEN = &H2               '最初から"色の作成"を押した状態で開く。
    CC_PREVENTFULLOPEN = &H4        '"色の作成"を押せなくなる。CC_FULLOPENが優先。
    'CC_SHOWHELP = &H8               'ヘルプボタンを表示。
    'CC_ENABLEHOOK = &H10            '動作のカスタマイズ用。
    'CC_ENABLETEMPLATE = &H20        'テンプレートの指定用。
    'CC_ENABLETEMPLATEHANDLE = &H40  'テンプレートの指定用。
    'CC_SOLIDCOLOR = &H80            'CC_ANYCOLORと関連？。違いが不明。
    'CC_ANYCOLOR = &H100             'CC_SOLIDCOLORと関連？違いが不明。色のところに純色が表示される（デフォルト）。
End Enum

'WinAPIChooseColor用構造体
Private Type CHOOSECOLOR
    lStructSize As Long         '構造体の大きさ（バイト単位）。
    hwndOwner As LongPtr        '親ウィンドウのハンドル。0可。
    hInstance As LongPtr        'テンプレート関連。
    rgbResult As Long           'ダイアログを開いたときの初期色＆戻り値の色。
    lpCustColors As LongPtr     '「作成した色」に表示する色を入れた配列のポインタ。
    flags As CColor             '各種フラグを組み合わせる。
    lCustData As LongPtr        'CC_ENABLEHOOK関連。
    lpfnHook As LongPtr         'CC_ENABLEHOOK関連。
    lpTemplateName As String    'テンプレート関連。
End Type

Private Declare PtrSafe Function _
    WinAPIChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" ( _
        ByRef pChoosecolor As CHOOSECOLOR) _
        As Long

'Win32APIのカラーダイアログを表示。
'引数
    'oPickedColor   ：戻り値用。選択された色が入る。キャンセル時は変更無し。
    'Hwnd           ：省略可。親ウィンドウのハンドル。ExcelならExcel.Application.Hwndで取得可能。
    'Flag           ：省略可。ダイアログの表示状態。

'戻り値
    'ダイアログでOKが押された時はTrue、キャンセル時はFalse。

Public Function ShowColorDialog( _
        ByRef oPickedColor As Long, _
        Optional ByVal Hwnd As LongPtr = 0, _
        Optional ByVal Flag As CColor = CC_RGBINIT + CC_FULLOPEN) As Boolean

    '「作成した色」に表示する用の色の配列。
        'ユーザーが作成した色を保存するため、静的変数で宣言。
    Static makedColors(0 To 15) As Long

    '「作成した色」の5色目～16色目に
    'MS Officeの今開いているファイルテーマカラーを設定する。
    'Word・Excel・PowerPointで確認。ホストがそれ以外の場合コメントアウト推奨。
    On Error Resume Next
        Call SetThemeColors(makedColors, ActiveOfficeFileTheme(Application))
    On Error GoTo 0

    Dim ccStruct As CHOOSECOLOR
    With ccStruct
        .lStructSize = LenB(ccStruct)   'VBA.LenB不可
        .hwndOwner = Hwnd
        .rgbResult = oPickedColor
        .lpCustColors = VBA.VarPtr(makedColors(LBound(makedColors)))
        .flags = Flag
    End With    'ccStruct

    If WinAPIChooseColor(ccStruct) = 0 Then
        Let ShowColorDialog = False
    Else
        Let oPickedColor = ccStruct.rgbResult
        Let ShowColorDialog = True
    End If
End Function


Private Sub SetThemeColors(ByRef oColors() As Long, ByVal iTheme As Office.OfficeTheme)
    Dim arrSize As Long
    arrSize = UBound(oColors) - LBound(oColors) + 1

    Dim myThemeColorScheme As Office.ThemeColorScheme
    Set myThemeColorScheme = iTheme.ThemeColorScheme

    If arrSize < myThemeColorScheme.Count Then
        Call Err.Raise(vbObjectError, "SetThemeColors", "配列が小さすぎます。")
    End If

    Dim i As Long
    Dim colorIndex As Long: colorIndex = 0
    For i = UBound(oColors) - myThemeColorScheme.Count + 1 To UBound(oColors)
        colorIndex = colorIndex + 1
        oColors(i) = myThemeColorScheme.Colors(colorIndex).RGB
    Next i
End Sub

Private Function ActiveOfficeFileTheme(ByVal OfficeApp As Object) As Office.OfficeTheme

    If VBA.TypeName(OfficeApp) <> "Application" Then GoTo Fail

    On Error GoTo Fail
        Select Case OfficeApp.Name
            Case "Microsoft Excel"
                Set ActiveOfficeFileTheme = OfficeApp.ActiveWorkbook.Theme
            Case "Microsoft PowerPoint"
                Set ActiveOfficeFileTheme = OfficeApp.ActivePresentation.SlideMaster.Theme
            Case "Microsoft Word"
                Set ActiveOfficeFileTheme = OfficeApp.ActiveDocument.DocumentTheme
            Case Else
                GoTo Fail
        End Select
    On Error GoTo 0
Exit Function
Fail:
    On Error GoTo 0
Call Err.Raise(vbObjectError, , "非対応のオブジェクトです。")
Exit Function

End Function

確認用コード

Sub TestShowColorDialog()
    Dim getColor As Long
    getColor = VBA.RGB(64, 255, 64)
    If ShowColorDialog(getColor) Then
        Debug.Print VBA.Hex$(getColor)
    End If
End Sub

注意点

SetThemeColors及び、ActiveOfficeFileThemeプロシージャを使用して今開いているOfficeファイルのテーマカラーを取得しているが、Word・Excel・PowerPoint以外では動作しない。

そのためそれ以外のホストアプリケーションで使用する場合は、該当箇所の削除を推奨。

ハマったところ

CHOOSECOLOR構造体のlpCustColorsに指定するもの

いくつかに参考にしたサイトがなぜかString型で宣言していて面食らった（「作成した色」配列へのポインタを指定する箇所）。
VBAのString型はByte配列へのポインタのはずなので、結果的に配列へのポインタとして機能させた、という事なのだと思われる。

C言語の配列のポインタは、配列先頭要素へのポインタのはずなので、
VBAではVBA.VarPtr(makedColors(LBound(makedColors)))とすれば必要なポインタが取得できる。

LenB関数

VBA.～のようにプリフィックスを設定すると実行できない。
プリフィックス無しなら問題無くユーザー定義型の大きさを取得できる。

宣伝

色関連でこちらもどうぞ
24bitカラーをRGBに分解する

参考

MSDN

API関数
[ChooseColor][ChooseColor]

構造体+定数（英語）
[CHOOSECOLOR structure][CHOOSECOLOR structure]

その他

VBA32bit用
カラーダイアログ（API）の使用 ： Excel(エクセル)

C言語で使用する場合の解説
UNICODE 版カレンダーソフトを１から作る 第21章 コモンダイアログを使って背景色を変更する

stackoverflow （英語）64bitで使用する場合のユーザー定義型の大きさについて。
Excel 64-bit and comdlg32.dll custom colours

関連記事

VBAでWindowsAPIを使うには - Qiita
FormatMessage で DLL 関数のエラーメッセージを取得する - Qiita
[VBA]広域変数を使用せずに、EnumChildWindowsの結果を取得する - Qiita