Excelが大好きだ!

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


スポンサードリンク

特定のセル範囲のみでダブルクリックイベントを発生するようにした

前回・前々回とセルをダブルクリックした時に色を塗るマクロについて紹介してきました。

www.excellovers.com

www.excellovers.com

今回は紹介時にtwitterでアドバイス頂いた内容を実装してみようと思います。

範囲を限定する

上記アドバイスの内、有効化/無効化については前回リボンへの登録で実装しています。
残りのアドバイスの内、「塗っても良いところは制限したほうが良い」を実装してみます。

標準モジュール

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 Then
                         .Color = 49407
                    Else
                         .Color = xlNone
                    End If
               End With
              Cancel = True
          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

Intersect関数

前回からの変更箇所は下記2点

  • 標準モジュール
    • Set myApp.setWS = ActiveSheet → Set myApp.setRng = Selection
  • EventGetクラス
    • Set TargetRng = Rngの追加
    • If Not (Intersect(TargetRng, Target) Is Nothing) Then の追加

「塗っても良いところは制限したほうが良い」の実装のために「DoubleClickSetColor」実行時に選択されているセル範囲(及びWorksheet)のみでダブルクリックイベントを発動するようにします。

そのために標準モジュールからクラスに渡すデータをWorksheetオブジェクトからRangeオブジェクトに変更しました。

EventGetクラス内ではまず標準モジュールから受け取ったRangeオブジェクトを元に、その親オブジェクトでWorksheetオブジェクトと受け取ったRangeオブジェクトをクラス内変数に渡しています。

次に上記で受け取っていたRangeオブジェクトとダブルクリックしたセルの判定を追加しました。
比較にはIntersect関数を使用しています。

Intersect(セル範囲1,セル範囲2[,セル範囲3-セル範囲30])

Intersect関数は引数に指定したセル範囲、全てに共通するセル範囲のRangeオブジェクトを返します。

例えば「E1:E5」と「E1」を引数に指定した場合、2つのセル範囲に共通する、「E1」というセル範囲のRangeオブジェクトを返します。

指定した引数に共通のセル範囲がなければ「Nothing」を返します。
追加したIf Not (Intersect(TargetRng, Target) Is Nothing)では次のような処理の流れになっています。

  1. Intersect(TargetRng, Target):クラスインスタンス作成時に受け取っていたセル範囲(TargetRng)とダブルクリックしたセルを比較して共通範囲がなければ「Nothing」
  2. Is Nothing:上記1の返り値がNothingかどうか判定。NothingであればTRUEを返す
  3. Not:上記2での判定式の結果を反転させます。2でNothingであればTRUEが返ってきていますが、その答えを反転させてFALSEにします。

つまり2つのセル範囲に共通部分が無ければダブルクリックイベントを発生させず、共通範囲があればダブルクリックイベントを発生させます。


以上でコードは完成です。 前回ご紹介の方法でアドイン化して使用出来るようにしてください。

完成形

完成品の挙動がこちらになります。 f:id:ExcelLover:20210124161344g:plain

マクロ実行時に選択されていたE1:E5以外ではダブルクリックイベントが発生していないのがわかるかと思います。

まとめ

先日のZOOM会でもそうでしたが、このように他の方から意見を頂いてブラッシュアップしていくとのは、自分の中に無いものがインプットされて面白いですね。