(Font.Color / Interior.Color)を取得する為に利用する場合は「SelectRGB=False 」と
して､右側のＲＧＢ画面が出ないようにしてください。
カラーパレットフォームの操作方法は「§5-8 ｋｔ関数メニュー ： カラーパレットＥＸ」参照
カラーパレットフォームを表示するサブルーチンです。
Call ktPaletteColorEX( PaletteEXData, [PaletteEXBook] )
PaletteEXData ‥‥‥ kt_PaletteEXType 型(ユーザー定義) (ByRef) PaletteEXBook ‥‥‥ String 型 (省略可､ 省略時： "Active" )
※引数[PaletteEXData]は､利用者側で下記のような『変数定義』が必要です。
Dim PaltteEXData As kt_PaletteEXType
ユーザー定義型[kt_PaletteEXType]は､[kt関数Addin.xla]内で下記のように定義されています。
（参照設定すれば利用できます）
Public Type kt_PaletteEXType ClipBoard As Boolean ' カラー選択時のクリップボードへのコピー有無 SelectRGB As Boolean ' RGB選択画面の展開有無 Flg As String ' Call時: 空 / "Init" / "Book" / "UnLoad"
' Return時: "Get" / "Cancel"ColorIndex As Integer ' 1〜56，RGB画面展開時は[99]固定 ColorLong As Long ' 0 〜 16777215 ColorHex As String ' BBGGRR 形式(6桁固定) ColorB As Integer ' 青： 0 〜 255 ColorG As Integer ' 緑： 0 〜 255 ColorR As Integer ' 赤： 0 〜 255 End Type
ClipBoard ‥‥ カラー決定時に､そのカラーの１６進("&Hbbggrr")をクリップボードにコピーするかどうかを指定します。
True ： コピーする , False ： コピーしないSelectRGB ‥‥ ＲＧＢ画面の展開可否を指定します。
セルに指定するカラーを取得する場合は[ False ]にしてパレットカラー以外の選択を不可にしてください。
True ： ＲＧＢ指定可 , False ： パレットカラーのみ可Flg ‥‥ ユーザーがカラーを選択したのか､キャンセルしたのかという情報が返る項目です。
"Get" ： カラーを選択 , "Cancel" ： キャンセル
初回Call時には､この項目に "Init" を設定してください。
「カラーパレットＥＸ」はＨｉｄｅモードでフォームを閉じますので､呼び元のマクロが終了する直前には､この項目に "UnLoad" を設定してCall してください（使用例参照）。
それ以外の時では､返ってきた "Get"/"Cancel" のままでCall して結構です。わざわざ「""」にクリアする必要はありません。
カラーパレットを取り込むブックを途中で切り換える場合は "Book" を設定してからCallします。ColorIndex ‥‥ カラーを選択した場合は下記の値が返ります。
RGB画面を展開時‥‥‥[ 99 ]固定
パレット画面のみ ‥‥‥[ 1〜56 ]のカラーインデックス番号
キャンセルした場合は[ゼロ]が返ります。ColorLong ‥‥ カラーを選択した場合は､そのカラーを１０進数で表現した
[ 0 〜 16777215 ]
の値が返ります。キャンセル時は[ゼロ]が返ります。ColorHex ‥‥ カラーを選択した場合は､そのカラーを１６進数で表現( BBGGRR 並び )した６桁の文字列が返ります。先頭に[ "&H" ]は付いていませんので､必要な場合はマクロ側で付加して下さい。
キャンセル時は空文字が返ります。ColorB,G,R ‥‥ カラーを選択した場合は､そのカラーの「青/緑/赤」属性を１０進数で表現した
[ 0 〜 255 ]
の数値が返ります。キャンセル時はゼロが返ります。
PaletteEXBook
‥‥
パレットを取得するブック名を指定します。
ここに指定するブックは､オープンされている必要があります。
省略､またはオープンされていないブックを指定した場合は「ｋｔ関数Addin.xla 」が適用されます（標準パレット）。
ActiveWorkbookのパレットを利用する場合は定数で"Active"と指定。
ActiveWorkbook以外のパレットを利用する場合は､そのブックの「Name プロパティ」の内容を指定します("Book1.xls" など定数で指定しても良いし､「Name プロパティ」自体を記述しても良いです)。
※ パレットカラー以外の色をセルに設定する事はできませんので､セルに指定するカラー
(Font.Color / Interior.Color)を取得する為に利用する場合は「SelectRGB=False 」と
して､右側のＲＧＢ画面が出ないようにしてください。
カラーパレットフォームの操作方法は「§5-8 ｋｔ関数メニュー ： カラーパレットＥＸ」参照
============== UserForm での利用例 ==================================
Private ColorData As kt_PaletteEXType '宣言セクションで定義
Private Sub UserForm_Initialize()
ColorData.ClipBoard = False ' 16進文字のクリップボードコピー無し
ColorData.SelectRGB = True ' RGB画面の展開有り
ColorData.Flg = "Init"
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If (ColorData.Flg <> "Init") Then
'一度でも呼び出されていたら[Load]状態のままなので最後に[UnLoad]する
ColorData.Flg = "UnLoad"
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
End If
End Sub
Private Sub Label1_Click()
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
'[色]を選択(Get)した場合のみ設定する
If (ColorData.Flg = "Get") Then
Label1.BackColor = ColorData.ColorLong
End If
End Sub
======== シート上のコマンドボタンでセル背景色変更の例 =========
※セルにはパレットの５６色しか使えないのでＲＧＢ展開はしない
'---------------[標準モジュール]-----------------------
Public ColorData As kt_PaletteEXType
'---------------[ThisWorkbook モジュール]--------------
Private Sub Workbook_Open()
ColorData.ClipBoard = False ' 16進文字のクリップボードコピー無し
ColorData.SelectRGB = False ' RGB画面の展開無し
ColorData.Flg = "Init"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If (ColorData.Flg <> "Init") Then
'一度でも呼び出されていたら[Load]状態のままなので最後に[UnLoad]する
ColorData.Flg = "UnLoad"
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
'別名保存後に元ブックを保存する時に､既にUnLoad済のところへ
'再びUnLoad指示を出さないようにする為の配慮
ColorData.Flg = "Init"
End If
End Sub
'--------------[シートモジュール]---------------------
Private Sub CommandButton1_Click()
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
'[色]を選択(Get)した場合のみ設定する
If (ColorData.Flg = "Get") Then
ActiveCell.Interior.Color = ColorData.ColorLong
End If
End Sub
============ デモマクロ =======================
Public Sub ktPaletteEXDemo()
Dim ColorData As kt_PaletteEXType
Dim MsgResp As Integer
ColorData.ClipBoard = True ' 16進文字のクリップボードコピー有り
ColorData.SelectRGB = True ' RGB画面の展開有り
ColorData.Flg = "Init"
Palette1:
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
If (ColorData.Flg = "Cancel") Then
MsgResp = MsgBox "【カラーパレットＥＸ デモ】" & vbCrLf _
& "キャンセルされました" & vbCrLf _
& "繰り返しますか？", vbYesNo + vbInformation
Else
MsgResp = MsgBox "【カラーパレットＥＸ デモ】" & vbCrLf _
& "受け取ったカラー情報は下記の通りです" & vbCrLf & vbCrLf _
& "（No） = " & ColorData.ColorIndex & vbCrLf _
& "16進 = 0x" & ColorData.ColorHex & "(BBGGRR)" & vbCrLf _
& "10進 = " & Format(ColorData.ColorLong, "#,##0") & vbCrLf _
& "（青） = " & ColorData.ColorB & vbCrLf _
& "（緑） = " & ColorData.ColorG & vbCrLf _
& "（赤） = " & ColorData.ColorR & vbCrLf _
& vbCrLf & "繰り返しますか？", vbYesNo + vbInformation
End If
If (MsgResp = vbYes) Then
GoTo Palette1
Else
ColorData.Flg = "UnLoad"
Call ktPaletteColorEX(ColorData, ThisWorkbook.Name)
End If
End Sub
