オートシェイプのクリックをユーザーフォームのリストボックスに反映する

昨日は、ブロック追加ボタンを条件成立時まで無効化してみました。

infoment.hatenablog.com

今日は、少し（大分？）後戻りします。

今日やりたいこと
必要なこと
- １．オートシェイプがクリックされたことを検知する
- ２．検知した結果をユーザーフォームのリストボックスに反映する
  - 【ユーザーフォームのモジュール】（EditChartForm）
結果

今日やりたいこと

今までの考え方は、ユーザーフォームの中のリストを選択して初めて、シート上のオートシェイプが操作できるというものでした。しかし、リストの項目を見ながらオートシェイプを選択する方式は、あまり直感的とは言えません。
できれば、オートシェイプを直接選択して操作したい。

そこで今回は、オートシェイプを選択した結果を、ユーザーフォームのリストボックスに反映することに挑戦です。今まで作成したものを少なからず破棄するため、（場当たり的な開発が祟って）結構な後戻りになります。

必要なこと

オートシェイプがクリックされたことを検知する
検知した結果をユーザーフォームのリストボックスに反映する

言葉にするのは簡単ですが、今回はいつにも増して初めての内容が多く、個人的にとても困難な道のりでした（未だ道半ばです）。

１．オートシェイプがクリックされたことを検知する

最初はWorkSheetの様々なイベントで、オートシェイプがクリックされたことを検知できないか試してみました。しかし、私が行った限りでは上手くいかず。

↓ こちらで対応することも考えましたが、私のレベルでは到達できませんでした。
thom.hateblo.jp

そこで、最初にオートシェイプを作成する際に、味付けすることにしました。

【標準モジュール】

Public Sub MakeBlock()
     
    Dim seq As Variant
        seq = Selection
        
        If IsArray(seq) = False Then
            MsgBox "空白セルが一つだけ選択されているため、処理を中断します。"
            Exit Sub
        End If
        
    ReDim SFC(1 To UBound(seq, 1), 1 To UBound(seq, 2))
    Dim i As Long, j As Long
        For j = 1 To UBound(seq, 2)
            For i = 1 To UBound(seq, 1)
                If seq(i, j) <> "" Then
                    Set SFC(i, j) = New ShapeClass
                    Set SFC(i, j).myShape = ActiveSheet.Shapes.AddShape(msoShapeFlowchartProcess, 50 + j * 200, 50 + i * 100, 100, 50)
                        SFC(i, j).myShape.TextFrame2.TextRange.Characters.Text = seq(i, j)
                        SFC(i, j).myShape.Name = SFC(i, j).myShape.Name & "_" & i & "_" & j

                        ' ↓↓今回追加した箇所↓↓
                        SFC(i, j).myShape.OnAction = "SelectShape"
                        ' ↑↑今回追加した箇所↑↑

                        SFC(i, j).SetFormat
                End If
            Next
        Next
        
End Sub

今回追加したのは、上記にある通り一行だけです。OnAction プロパティで、作成した全てのオートシェイプに「SelectShape」という名前のサブプロシージャを登録しました。これにより、上記マクロで作成されたオートシェイプに限り、クリックすると SelectShape が実行されるようになったわけです。

SelectShapeの中身自体は、とてもシンプルです。

どのオートシェイプがクリックされたかを検知する。
ユーザーフォームのリストを更新する。

まず、どのオートシェイプが選択されたか。これは、Application.Callerで取得できるということが分かりました。

Public Sub SelectShape()
    MsgBox Application.Caller
End Sub

f:id:Infoment:20180924224007p:plain

しかしこの OnAction プロパティは厄介なことに、プロシージャを実行する代わりに「クリックしても選択しない」ようです。そこで、昨日まで作成してきたユーザーフォーム（EditChartForm）用のクラスモジュールを一つ準備して、そちらで対応することにしました。

【クラスモジュール】（EditChartClass）

Application.Callerで取得した名前の格納用。

Public ShapeName As String

クラスモジュールの初期化。ユーザーフォームを表示させる。

Private Sub Class_Initialize()
    If UserForms.Count = 0 Then
        EditChartForm.Show vbModeless
    End If
End Sub

クリックされたオートシェイプの名前で、同オートシェイプを変数に格納する。

Public Property Get ClickedShape() As Shape
    Set ClickedShape = ActiveSheet.Shapes(ShapeName)
End Property

今までユーザーフォームの初期化に記載していたもののうち、リスト用の配列取得までをこちらに移植。

Public Function ShapeList() As Variant
    Dim Shape As Shape
    Dim ListBoxSeq As Variant
    ReDim ListBoxSeq(1 To ActiveSheet.Shapes.Count, 1 To 3)
    Dim i As Long
        i = 1
        For Each Shape In ActiveSheet.Shapes
            If Shape.Connector = msoFalse Then
                ListBoxSeq(i, 1) = Shape.TextFrame2.TextRange.Characters.Text
                ListBoxSeq(i, 2) = Shape.ID
                ListBoxSeq(i, 3) = 0
                i = i + 1
            End If
        Next
        ShapeList = ListBoxSeq
End Function

オートシェイプが選択された順に、それがリストボックス内のどの項目かを調べる。該当するものがあれば、リストの３列目に通し番号をセットしたうえで、同項目を選択状態にする。

Public Sub UpdateOrder()
    With EditChartForm.ListBox1
        Dim Shape As Shape
        Dim i As Long
        Dim ShapeCounter As Long
            ShapeCounter = 1
            On Error GoTo er:
            For Each Shape In Selection.ShapeRange
                For i = 0 To .ListCount - 1
                    If Shape.ID = .List(i, 1) Then
                        .Selected(i) = True
                        .List(i, 2) = ShapeCounter
                        ShapeCounter = ShapeCounter + 1
                        Exit For
                    End If
                Next
            Next
    End With
    Exit Sub
er:
End Sub

コネクタを除く全オートシェイプのうち、選択状態にあるものの個数を取得する。

Public Property Get TotalSelectionNumber() As Long
    On Error Resume Next
    TotalSelectionNumber = Selection.ShapeRange.Count
    If Err.Number <> 0 Then
        TotalSelectionNumber = 0
        On Error GoTo 0
    End If
End Property

ここまで準備すれば、SelectShape の中身はシンプルなものになります。

【標準モジュール】

Public Sub SelectShape()
    Dim ECC As EditChartClass
    Set ECC = New EditChartClass
    
    ECC.ShapeName = Application.Caller
    ECC.ClickedShape.Select False
    ECC.UpdateOrder
End Sub

２．検知した結果をユーザーフォームのリストボックスに反映する

１．でほぼ準備が整ったので、ユーザーフォームの初期化を修正します。

【ユーザーフォームのモジュール】（EditChartForm）

Private Sub UserForm_Initialize()
    ' ↓↓今回の変更箇所↓↓
    Set ECC = New EditChartClass
    ListBox1.List = ECC.ShapeList
    ECC.UpdateOrder
    ' ↑↑今回の変更箇所↑↑

    Dim ComboBoxSeq(1 To 3, 1 To 2)
        ComboBoxSeq(1, 1) = "接点": ComboBoxSeq(1, 2) = msoShapeFlowchartTerminator
        ComboBoxSeq(2, 1) = "処理": ComboBoxSeq(2, 2) = msoShapeFlowchartProcess
        ComboBoxSeq(3, 1) = "分岐": ComboBoxSeq(3, 2) = msoShapeFlowchartDecision

        With ComboBox1
            .ColumnCount = 2
            .TextColumn = 1
            .BoundColumn = 2
            .List = ComboBoxSeq
        End With
End Sub