ちょっと長めのタイトルになってしまったが、要はこんなの↓を作った。
VBEのメニューからパレットを起動し、目当ての色のラベルをクリックするだけでカーソル位置にRGB関数が挿入される。
きっかけはこちらの記事。(感謝)
chemiphys.hateblo.jp
作りかた
このマクロはVBEで現在カーソルのある位置にRGB関数を挿入する仕様になっているが、通常F5で起動できるのは現在のカーソル位置のマクロである。だからF5だと被操作コードと、操作コードが同一になってしまうというジレンマがあり、やりたいことが実現できない。
そこでまず、マクロをメニューから実行できるようにする。
以下の記事を参照し、アドインを作っておくと良い。
thom.hateblo.jp
そしてこのアドインにユーザーフォームを追加し、オブジェクト名をColorPickerに変更する。
フォームに記述するコードはこちら。変数宣言が抜けてたりプロシージャの名前がhogeのままだったり、まぁ酷いコードなのだが勢いで公開してしまおう。みなさんが作る場合は悪いところをマネしないように。。
Private Const LabelSizeX = 20 Private Const LabelSizeY = 15 Private ColorLabels As Collection Private Sub UserForm_Initialize() Set ColorLabels = New Collection hoge Me.Height = (LabelSizeY) * 10 - 5 Me.Width = LabelSizeX * 9 - 4 End Sub Sub WriteLabel(x, y, color As Long) With New EventControl Set .AsLabel = Me.Controls.Add("Forms.Label.1") With .AsControl .Height = LabelSizeY .Width = LabelSizeX .Left = x * (LabelSizeX - 1) .Top = y * (LabelSizeY - 1) End With With .AsLabel .BackColor = color .BorderStyle = fmBorderStyleSingle End With ColorLabels.Add .Self End With End Sub Sub hoge() colorBase = 51 ColorPallets = Array( _ Array(5, 0, 0), Array(5, 3, 0), Array(3, 5, 0), _ Array(0, 5, 0), Array(0, 5, 3), Array(0, 3, 5), _ Array(0, 0, 5), Array(3, 0, 5), Array(5, 0, 3)) Dim R, G, B For i = 0 To 8 For j = 0 To 4 cp = ColorPallets(i) R = (cp(0) - j) * colorBase G = (cp(1) - j) * colorBase B = (cp(2) - j) * colorBase If R < 0 Then R = 0 If G < 0 Then G = 0 If B < 0 Then B = 0 WriteLabel 4 - j, i, RGB(R, G, B) Next Next For i = 0 To 8 For j = 1 To 4 cp = ColorPallets(i) R = (cp(0) + j) * colorBase G = (cp(1) + j) * colorBase B = (cp(2) + j) * colorBase If R > 255 Then R = 255 If G > 255 Then G = 255 If B > 255 Then B = 255 WriteLabel j + 4, i, RGB(R, G, B) Next Next End Sub
次にクラスモジュールを挿入し、オブジェクト名を「EventControl」とする。
EventControlのコードはこちら。
Public WithEvents AsLabel As MSForms.Label Property Get AsControl() As MSForms.Control Set AsControl = AsLabel End Property Property Get Red() Red = &HFF& And AsLabel.BackColor End Property Property Get Green() Green = (&HFF00& And AsLabel.BackColor) \ 256 End Property Property Get Blue() Blue = (&HFF0000 And AsLabel.BackColor) \ 256 \ 256 End Property Property Get RGBFuncAsString() As String RGBFuncAsString = "RGB(" & Red & ", " & Green & ", " & Blue & ")" End Property Private Sub AsLabel_Click() ColorPicker.Hide Application.VBE.MainWindow.Visible = True InsertCode RGBFuncAsString End Sub Property Get Self() As Object Set Self = Me End Property
次に標準モジュールを追加し、オブジェクト名を「fnInsertCode」としておく。
コードは以下のプロシージャひとつのみ。
Sub InsertCode(code As String) Dim sl As Long, sc As Long, el As Long, ec As Long Application.VBE.ActiveCodePane.GetSelection sl, sc, el, ec L = Application.VBE.ActiveCodePane.CodeModule.Lines(sl, 1) L2 = Left(L, sc - 1) & code & Mid(L, sc) Application.VBE.ActiveCodePane.CodeModule.ReplaceLine sl, L2 Application.VBE.ActiveCodePane.SetSelection sl, sc + Len(code) + 1, sl, sc + Len(code) + 1 End Sub
最後にMenuMacrosモジュールに以下を追加する。
MenuMacrosモジュールは先ほど紹介した記事「VBA 標準モジュールのマクロを読み取って起動時にVBEのメニューに自動登録するアドインを自作する」で作成したもので、ここに登録しておくだけでVBEのMyToolsメニューに追加されるというものだ。
Sub カラーパレットを表示() 'O With Application.VBE.ActiveCodePane ColorPicker.Show .Show End With End Sub
これで準備完了。あとは変更したアドインを保存し、Excelを起動しなおすと冒頭のGIFアニメのように使用できるようになる。
ざっくり解説
今回はいろいろ試行錯誤してたので結構ひどいコードになった。まだまだ整理できそうだけど気力がないのでいったんこの状態で、おおまかに解説する。
まず自動メニュー登録アドインの動作はこんな感じ。
Auto_Openで起動時にMenuMacrosモジュールからマクロのタイトル部を配列として抜き出してきて、それをもとにメニューを作成している。
カラーパレットはこんな感じ。
メニューから起動されフォームがShowされると、まずフォームはカラーラベルを生成し、それをそれぞれ生成したEventControlに保持させる。このEventControlはフォーム内部のコレクションが保持する。ここまでがフォーム表示までの流れ。
それからユーザー操作からフォームクローズまでの流れは青字で書いた。
ユーザーがカラーラベルをクリックするとEventControl内のClickイベントが発火され、fnInsertCodeで現在選択されている箇所にRGB関数が挿入される。
以上で解説を終える。
フローチャートのときもそうだけれど、ある程度複雑になってくると作り方の紹介で精いっぱいで、コードの細かいところまで解説する気力が湧かない。
そして完成させるのが精いっぱいで分かりやすいコードに修正する気力も。。
おまけ
実はカラーラベルは枠線で誤魔化してるんだけど、同じ色の箇所がいくつもあったりして。
Webセーフカラーというものからパレットっぽい色をチョイスしたかったのでRGB値をそれぞれ51の倍数にしようとこだわった結果、無理が出てこうなった。
ラベルは9*9で81枚なので計算で求めようとせずに1枚ずつ愚直にカラーコードを作ってしまっても良いかもしれない。
あ、あとわざわざ自前で作らなくてもWin32APIのカラーピッカーを呼ぶ手もある。