【VBA】クリックしたセルからクリックしたセルに線を引く(コマンドメニュー付+アドイン化)

'''標準モジュール'''
Public マクロ実行中 As Boolean
Public FirstClick As Boolean
Public rngStart As Range, rngEnd As Range

Function マクロ()
    UserForm1.Show vbModeless
End Function

'''UserForm1(toggleボタン)'''
'Option Explicit
Private Sub ToggleButton1_Click()
    With ToggleButton1
        If .Value Then
            マクロ実行中 = True
            'トグルボタンONの処理
            .Caption = "マクロON"
        Else
            'トグルボタンOFFの処理
            .Caption = "マクロOFF"
            マクロ実行中 = False
        End If
    End With
End Sub

'''ThisWorkbook'''
'Option Explicit
Dim MyEvent As New Class1

Private Sub Workbook_Open()
    Dim objCB As CommandBar
    Dim objCBCtrl As CommandBarControl
    
    Set objCB = Application.CommandBars("Worksheet Menu Bar")
    
    On Error Resume Next
    objCB.Controls("ユーザーマクロ").Delete
    On Error GoTo 0
    
    Set objCBCtrl = objCB.Controls.Add(Type:=msoControlPopup, Temporary:=True)
    objCBCtrl.Caption = "ユーザーマクロ"
 
    With objCBCtrl
        .Controls.Add Type:=msoControlButton
        With .Controls(1)
            .Caption = "線描画"
            .OnAction = "マクロ"
        End With
    End With

    Set MyEvent.MyAppEvents = Application
End Sub

'選択したセルからセルに自動で線を引く'
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim BX As Single, BY As Single, EX As Single, EY As Single

    If マクロ実行中 = True Then
        If FirstClick = False Then
            Set rngStart = Target
            FirstClick = True
        Else
            FirstClick = False
            'Shapeを配置するための基準となるセル
            Set rngEnd = Target

            'セルのLeft、Top、Widthプロパティを利用して位置決め
            BX = rngStart.Left
            BY = rngStart.Top
            EX = rngEnd.Left + rngEnd.Width
            EY = rngEnd.Top

            '直線
            'ActiveSheet.Shapes.AddLine BX, BY, EX, EY

            '赤色・太さ1.5ポイントの矢印線
            With ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
                .ForeColor.RGB = vbRed
                .Weight = 1.5
                .EndArrowheadStyle = msoArrowheadTriangle
            End With
        End If
    End If
End Sub

'''Class1'''
'Option Explicit
Public WithEvents MyAppEvents As Application

Private Sub MyAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim BX As Single, BY As Single, EX As Single, EY As Single

    If マクロ実行中 = True Then
        If FirstClick = False Then
            Set rngStart = Target
            FirstClick = True
        Else
            FirstClick = False
            'Shapeを配置するための基準となるセル
            Set rngEnd = Target

            'セルのLeft、Top、Widthプロパティを利用して位置決め
            BX = rngStart.Left
            BY = rngStart.Top
            EX = rngEnd.Left + rngEnd.Width
            EY = rngEnd.Top

            '直線
            'ActiveSheet.Shapes.AddLine BX, BY, EX, EY

            '赤色・太さ1.5ポイントの矢印線
            With ActiveSheet.Shapes.AddLine(BX, BY, EX, EY).Line
                .ForeColor.RGB = vbRed
                .Weight = 1.5
                .EndArrowheadStyle = msoArrowheadTriangle
            End With
        End If
    End If
End Sub

###参考
https://www.forguncy.com/blog/20181217_clickevent
https://kazusa-pg.com/vba-get-coordinates/
https://www.relief.jp/docs/excel-vba-select-cells-application-inputbox-methot.html
https://docs.microsoft.com/ja-jp/office/vba/api/excel.application.inputbox
http://officetanaka.net/excel/vba/tips/tips13.htm
https://www.vba-ie.net/event/sheetselectionchange.php
メニューバーに独自のメニューを追加する
メニューが複数追加されないように
Excel-VBA　全てのシートで共通したイベントWorkSheetのChangeとSelectionChangeでの処理