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 で動作確認。
## ラップしたコード
```vb: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