Ctrl+クリックで複数セル選択中に失敗したとき一個戻すマクロ Ver.2

イベントプロシージャを使う方法で書き直してみました。
それほどニーズのある機能ではないかもしれませんが、他では見たことが無い機能なので、公開しておきます。

ダウンロード

http://space.geocities.jp/micnak2001/vba/CancelOverlappedSelection.zip

使用方法

ダウンロードしたら、中のファイルを適当な場所に移して開くと機能が有効になります。

機能

Ctrl+クリックで次々選択していったときに、失敗したらもう一度クリックすることで、選択を取り消せます。

コード

Dim WithEvents AppEventCatcher As Application
Private Sub InitEventCatcher()
    Set AppEventCatcher = Application
End Sub

Private Sub AppEventCatcher_SheetSelectionChange(ByVal Sh As Object, ByVal Target As
Range)
     On Error GoTo Exit_
    If Target.Cells.Count = 1 Then

        GoTo Exit_
    End If

    Dim Last As Range
    Set Last = Target.Areas(Target.Areas.Count)

    Dim NewSelection As Range
    Dim ExistsOverlap As Boolean
    ExistsOverlap = False
    Dim i As Long
    For i = 1 To Target.Areas.Count - 1
        Dim Intersection As Range
        Set Intersection = Intersect(Target.Areas(i), Last)
        If Intersection Is Nothing Then
            If NewSelection Is Nothing Then
                Set NewSelection = Target.Areas(i)
            Else
                Set NewSelection = Union(NewSelection, Target.Areas(i))
            End If
        Else
            ExistsOverlap = True
        End If
    Next
    If ExistsOverlap Then
        NewSelection.Select
        NewSelection.Areas(NewSelection.Areas.Count).Activate
    End If
Exit_:
End Sub

Private Sub Workbook_Open()
    InitEventCatcher
End Sub

robbie21's blog

Ctrl+クリックで複数セル選択中に失敗したとき一個戻すマクロ Ver.2

関連