実務では全く役に立ちそうにないツールです。
ですが、組み込まれている仕組みだけ見ると、色々な普段使わない機能を組み込んだ面白いツールだと思います。
ある特定のボタンが押されている間だけ、実行される仕組みと、マウスの座標を取得する仕組み、そして取得したマウスの座標とセルを連結させる仕組みが組み込まれています。
VBAで工夫次第で計算以外にもいろいろと面白いものが作れます。
1.ツールの動画
まずはどんなものを作ったか、実際にツールを動かしている動画をご覧ください。
動画は2倍速になっています。
注目して頂きたい点は、アクティブになっているセルと色を塗りつぶしているセルが違うところです。
また、ずっと塗りつぶされているわけではないというところです。
これはセルを選択して、塗り潰しているのではありません。
選択はあくまでカラー一覧の色を指定しています。
また、常に塗りつぶされている訳ではなく、塗りつぶしたいところだけ塗り潰しています。
2.ロジックの説明
どんなツールか動画を見て理解して頂いたかと思います。
どの様なロジックで動いているか、簡単にですが説明したいと思います。
大きく分けると4つのロジックの組み合わせとなっていて、一つ一つを見ると実はそこまで難しくありません。
その1 マウスの座標を取得する
まずは、セルを選択せずにマウスがある位置のセルを指定する必要があります。
そのため、マウスの座標を取得しなければなりません。
マウスの座標を取得するには、API「GetCursorPos」を使用します。
マウスの座標とセルの連携については「マウスカーソルの位置とセルの連携」をご覧ください。
その2 マウスの座標とセルを連動させる
その1で取得したマウスの座標とセルを連動させることで、セルを選択しなくてもセルを指定する事が出来ます。
VBAでセルをSelectしなくても指定出来るのと同じ原理ですね。
こちらも詳細は上記リンクを参照ください。
その3 アクティブセルで色を取得する
次は色を取得する部分です。
こちらは簡単です。
あらかじめセルを塗りつぶした一覧を用意しておいて、セルで選択したら選択したいセルの背景色を取得してRGBへ変換できるようにします。
その4 特定のボタンが押されている間だけ実行させる
マクロには指定したボタンを押している間だけ、実行出来る「GetAsyncKeyState」があります。
これを使用する事で、特定のボタンが押されている間のみ実行するプログラムを組むことが可能です。
枠線の中で、色を塗りつぶしたい時のみボタンを押すと色が塗りつぶされるようになります。
今回は「シフト」ボタンを押している間だけ実行できるようにしました。
3.サンプルコード
すべて標準モジュールに記述しています。
スタートボタンと、クリアボタンはクリックイベントで呼び出しているだけです。
普段あまり使用しない機能を使用しているので難しく感じますが、1つ1つ見ていくとロジック自体は難しくありません。
マウスの座標を取得する部分とAPIの宣言
Option Explicit
'位置座標用の構造体
Private Type POINTAPI
x As Long
y As Long
End Type
'マウスカーソルの位置を取得するAPI
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Longメインとなる塗りつぶし
Sub Sample1()
Dim p As POINTAPI 'API用変数
Dim Getcell As Range
On Error Resume Next
Do While True
DoEvents
GetCursorPos p 'カーソル位置取得
Set Getcell = ActiveWindow.RangeFromPoint(p.x, p.y) 'マウスカーソルの位置をセルと連携
If Not Application.Intersect(Getcell, Range("U15:BZ66")) Is Nothing Then
If GetAsyncKeyState(vbKeyShift) Then 'Shiftキーを押しているか判定
Call ColorGet(Getcell) '取得したセルを塗りつぶす
End If
End If
Loop
End Subここが少し難しいですが、「Do While True」で意図的に無限ループをしています。
「GetCursorPos p」でカーソルの座標を取得しています。
「Set Getcell = ActiveWindow.RangeFromPoint(p.x, p.y)」でマウスの座標とセルを連動させています。
「If Not Application.Intersect(Getcell, Range(“U15:BZ66”)) Is Nothing Then」は枠線内以外では、塗りつぶしが実行されないように制御するための分岐処理です。
そしてここが今回のポイントなっていて、「If GetAsyncKeyState(vbKeyShift) Then」でシフトを押している間のみ実行される仕組みです。
アクティブセルのカラーを取得
Sub ColorGet(ByVal Getcell As Range)
Dim myColor As Long
Dim myR As Long
Dim myG As Long
Dim myB As Long
myColor = ActiveCell.Interior.Color
myR = myColor Mod 256
myG = Int(myColor / 256) Mod 256
myB = Int(myColor / 256 / 256)
Getcell.Interior.Color = RGB(myR, myG, myB)
End Sub「myColor = ActiveCell.Interior.Color」で選択しているセルの背景色を取得しています。
「myR 」～「myB 」についてはRGBで色を扱えるように変換しています。
そして、「Getcell.Interior.Color = RGB(myR, myG, myB)」の部分でRGBで扱えるように変換した数値で、マウスと連動しているセルの塗りつぶしに指定します。
枠線内の塗りつぶしをクリアする
Sub Cells_Clear()
Range("U15:BZ66").Interior.Color = RGB(255, 255, 255)
End Sub「Range(“U15:BZ66”).Interior.Color = RGB(255, 255, 255)」で枠線内の色を白にしています。
4.サンプルデータ
今回動画で使用したデータをそのままダウンロードできるようにしておきます。
マクロの停止ボタンは用意していないため、強制的に閉じるか、VBEから停止してください。
無限ループしていますが、Doeventsで制御できるようになっています。
