読者です 読者をやめる 読者になる 読者になる

t-hom’s diary

主にVBAネタを扱っているブログです。

VBA VBエディタ上から実行できるRGB関数入力用のカラーパレットフォームを作成

VBA

ちょっと長めのタイトルになってしまったが、要はこんなの↓を作った。
f:id:t-hom:20170107153539g:plain

VBEのメニューからパレットを起動し、目当ての色のラベルをクリックするだけでカーソル位置にRGB関数が挿入される。

きっかけはこちらの記事。(感謝)
chemiphys.hateblo.jp

作りかた

このマクロはVBEで現在カーソルのある位置にRGB関数を挿入する仕様になっているが、通常F5で起動できるのは現在のカーソル位置のマクロである。だからF5だと被操作コードと、操作コードが同一になってしまうというジレンマがあり、やりたいことが実現できない。

そこでまず、マクロをメニューから実行できるようにする。
以下の記事を参照し、アドインを作っておくと良い。
thom.hateblo.jp

そしてこのアドインにユーザーフォームを追加し、オブジェクト名をColorPickerに変更する。
f:id:t-hom:20170107154753p:plain

フォームに記述するコードはこちら。変数宣言が抜けてたりプロシージャの名前が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アニメのように使用できるようになる。

ざっくり解説

今回はいろいろ試行錯誤してたので結構ひどいコードになった。まだまだ整理できそうだけど気力がないのでいったんこの状態で、おおまかに解説する。

まず自動メニュー登録アドインの動作はこんな感じ。
f:id:t-hom:20170107161147p:plain
Auto_Openで起動時にMenuMacrosモジュールからマクロのタイトル部を配列として抜き出してきて、それをもとにメニューを作成している。

カラーパレットはこんな感じ。
f:id:t-hom:20170107162203p:plain
メニューから起動されフォームがShowされると、まずフォームはカラーラベルを生成し、それをそれぞれ生成したEventControlに保持させる。このEventControlはフォーム内部のコレクションが保持する。ここまでがフォーム表示までの流れ。

それからユーザー操作からフォームクローズまでの流れは青字で書いた。
ユーザーがカラーラベルをクリックするとEventControl内のClickイベントが発火され、fnInsertCodeで現在選択されている箇所にRGB関数が挿入される。

以上で解説を終える。

フローチャートのときもそうだけれど、ある程度複雑になってくると作り方の紹介で精いっぱいで、コードの細かいところまで解説する気力が湧かない。

そして完成させるのが精いっぱいで分かりやすいコードに修正する気力も。。

おまけ

実はカラーラベルは枠線で誤魔化してるんだけど、同じ色の箇所がいくつもあったりして。
f:id:t-hom:20170107163058p:plain
Webセーフカラーというものからパレットっぽい色をチョイスしたかったのでRGB値をそれぞれ51の倍数にしようとこだわった結果、無理が出てこうなった。

ラベルは9*9で81枚なので計算で求めようとせずに1枚ずつ愚直にカラーコードを作ってしまっても良いかもしれない。

あ、あとわざわざ自前で作らなくてもWin32APIのカラーピッカーを呼ぶ手もある。

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。