Excelが大好きだ!

Excel大好き経理マンがExcelの事を書き綴っていきます。


スポンサードリンク

マウスカーソルを移動させるだけでセルに色を塗れるようにした

前回はtwitterのフォロワーさんから頂いたアドバイスを組み込んでみました。
www.excellovers.com

今回は別のフォロワーさんから頂いたアドバイスを組み込んでみようと思います。

上記アドバイスの内「シングルクリックやキー押下でセル色の設定・解除/数色の切り替え」を実装してみます。


コード

前回のコードを修正・追加した完成形のコードがこちら

標準モジュール

Dim myApp As New EventGet

Public Sub DoubleClickSetColor()
     Set myApp = New EventGet
     Set myApp.setRng = Selection
End Sub
Public Sub DoubleClickSetColorOff()
     Set myApp = Nothing
End Sub

EventGetクラス

Public WithEvents myApps As Application
Private TargetWS As Worksheet
Private TargetRng As Range
'----------------------------------
Private Sub myApps_SheetBeforeDoubleClick(ByVal Sh As Object, _
     ByVal Target As Range, Cancel As Boolean)
     
     If TargetWS.Parent.FullName & "-" & TargetWS.Name = _
          Sh.Parent.FullName & "-" & Sh.Name Then
          
          If Not (Intersect(TargetRng, Target) Is Nothing) Then
               With Target.Interior
                    If (.ColorIndex = xlNone) Or (.Color = vbCyan) Then  '← 変更箇所
                         .Color = 49407
                    Else
                         .Color = xlNone
                    End If
               End With
              Cancel = True
          End If
     End If
End Sub
'----------------------------------
Private Sub myApps_SheetSelectionChange(ByVal Sh As Object, _
     ByVal Target As Range)
     
     If TargetWS.Parent.FullName & "-" & TargetWS.Name = _
          Sh.Parent.FullName & "-" & Sh.Name Then
          
          If Not (Intersect(TargetRng, Target) Is Nothing) Then
               With Target.Interior
                    If .ColorIndex = xlNone Then
                         .Color = vbCyan
                    Else
                         .Color = xlNone
                    End If
               End With
          End If
     End If
End Sub
'----------------------------------
Public Property Set setRng(Rng As Range)
     Set myApps = Application
     Set TargetWS = Rng.Parent
     Set TargetRng = Rng
End Property

標準モジュールに変更はありません。

前回作成したダブルクリックイベントには1ヶ所修正を行っています。

If (.ColorIndex = xlNone) Or (.Color = vbCyan) Then

タブルクリックしたセルの塗りつぶしが、なし or シアン(水色)の場合TRUEになるようにしました。
これは後で今回追加する処理に対応させるためです。


SelectionChange

アドバイス頂いた内容の内「シングルクリックやキー押下」に対応させるために「SelectionChange」イベントを追加しました。

イベントの追加方法下記の記事をご参考に。

www.excellovers.com

範囲限定あるとき・ないとき

BeforeDoubleClickイベントはセルをダブルクリックした時にイベントが発生していました。

このSelectionChangeイベントは選択しているセルが変わった時にイベントが発生します。

実は当初このセル塗りつぶしを考えたときはこのSelectionChangeイベントを使おうと思っていました。
しかしこのイベントを今回の塗りつぶしで、工夫無しにしようすると…
f:id:ExcelLover:20210128170807g:plain

触れるもの全てをシアンに染めてしまい、本来チェックして色を塗りたいと思っているセル以外を塗る羽目になります。

そのため当初BeforeDoubleClickイベントを使用することで意図しないセルを塗りつぶさずに済むようにしていました。


しかし前回実装したイベント範囲を限定するテクニックと組み合わせることで、イベントが暴発することを防ぐことが出来ます。
f:id:ExcelLover:20210128170953g:plain

このようにクラスインスタンス作成時に選ばれていたセル以外ではイベントが発生しません。

これでダブルクリックをしなくてもカーソルを移動させるだけで色を塗ることが出来ます。


色塗り分け

次は「数色の切り替え」を実装します。

今回は「無色」「オレンジ」「シアン」を塗り分けるようにします。

これは上記で紹介したダブルクリックイベント内の修正とSelectonChangeの合せ技で対応しています。

書類チェックで一番使用する「問題なし」をシアンとします。
無色←→シアンの色塗りはカーソル移動だけで実行できるSelectonChangeイベントで行います。

チェックして問題がある箇所をオレンジとします。
これは発生頻度が低いはずなので一手間かかるダブルクリックイベントで行います。

ダブルクリックイベントの挙動を下記のように設定しています。

セル色 ダブルクリック後
無色 オレンジ
シアン オレンジ
上記以外 無色

この設定であれば問題があった箇所をダブルクリックすればだいたいオレンジになります。
f:id:ExcelLover:20210128171035g:plain

まとめ

これでダブルクリックでセルに色塗りシリーズ終了です。
フォロワーさんからアドバイスを頂いたおかげで当初作成案より良いものに仕上がりました。

なにかのきっかけになれれば嬉しいです。