全選択・全解除などの機能を追加

昨日は、接続済みのコネクタを、リストから除外してみました。

infoment.hatenablog.com

今日は、実際に使用するための幾つかの機能を追加することに挑戦です。

今日やりたいこと

実際に使用する場合を考えて、便利ボタンを幾つか準備します。また、これに合わせて、既存の機能を調整します。

1. オートシェイプを一括で全て選択する
2. オートシェイプを一括で選択解除する
3. コネクタを一括で全て削除する
4. 接続後のオートシェイプ選択を解除する
5. ユーザーフォームを閉じる

必要なこと

1. 全選択ボタンの設置
2. 全解除ボタンの設置
3. コネクタ全削除ボタンの設置
4. 接続ボタンの機能調整
5. 終了ボタンの設置

数は多いですが、一つ一つはさほど難しくありません。

１．全選択ボタンの設置

リストの全項目を選択し、オートシェイプを全選択します。全選択する場合、SelectAllという便利なメソッドがあるので、これを使用してみましょう。

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

Private Sub AllSelectButton_Click()
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(i) = True
            ListBox1.List(i, 2) = i + 1
        Next
        ActiveSheet.Shapes.SelectAll        
End Sub

２．全解除ボタンの設置

リストの全項目を非選択し、オートシェイプの選択も全て解除します。SelectAllの反対に全て解除するメソッドがあればいいのですが、無さそうなので、A1セルを選択することで全解除に代えることにします。

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

Private Sub AllDeselectButton_Click()
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            ListBox1.Selected(i) = False
            ListBox1.List(i, 2) = 0
        Next
        Range("A1").Select
End Sub

３．コネクタを一括で削除する

以下の手順で行います。

1. 一旦、全てのオートシェイプ選択を解除する。
2. For ～ Next ループで全てのオートシェイプを確認し、コネクタであれば選択。
3. 選択したものを削除する。

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

Private Sub DeleteConnectorButton_Click()
    Range("A1").Select
    Dim Shape As Shape
    For Each Shape In ActiveSheet.Shapes
        If Shape.Connector = msoTrue Then
            Shape.Select False
        End If
    Next
    
    On Error Resume Next
    Selection.Delete
End Sub

なお、エディター（VBE）で、ボタン選択状態でもういちどボタンをクリックすると、文字の編集ができるようになります。このとき、Ctrl キーを押しながらEnterキーを押すと、ボタン内で改行できます。

４．接続ボタンの機能調整

接続が終わったオートシェイプの選択を解除します。といっても、大層なことはしません。接続ボタンの最後に、全解除と同じことをするだけです。

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

Private Sub ConnectButton_Click()
    If iMax = 2 Then Exit Sub
    Dim SC() As ShapeClass
    ReDim SC(1 To iMax - 1)
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                Dim myID As Long
                    myID = ListBox1.List(i, 1)
                Dim myIndex As Long
                    myIndex = ListBox1.List(i, 2)
                    Set SC(myIndex) = New ShapeClass
                    Set SC(myIndex).myShape = TargetShape(myID)
            End If
        Next
        For i = 1 To iMax - 2
            Call ConnectShape(SC(i).myShape, SC(i + 1).myShape)
        Next
' --------------↓↓前回からの変更箇所↓↓--------------
        Range("A1").Select
' --------------↑↑前回からの変更箇所↑↑--------------
End Sub

５．終了ボタンの設置

ユーザーフォームを閉じます。

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

Private Sub EndButton_Click()
    Unload Me
End Sub

結果

これで、とりあえず一通りの機能がそろいました。

次回に続きます。

参考まで。