シートとユーザーフォームの両方でオートシェイプを選択する

昨日は思い立って、シート上で直接オートシェイプを選択した結果を、ユーザーフォームのリストボックスに反映してみました。

infoment.hatenablog.com

今日は、昨日の結果壊れてしまった、「リストボックスでの選択」機能の復元に挑戦です。

今日やりたいこと

まず、昨日の内容の内容を3点修正します。
次いでユーザーフォームの中身を、オートシェイプ直接編集の仕様に合わせて修正します。

必要なこと

  1. フローチャート編集用ユーザーフォームの呼び出し方変更
  2. オートシェイプリスト用配列のRedim追加
  3. クラスモジュール用変数をユーザーフォームのモジュールレベル変数化
  4. リストボックスで項目を選択した際のコードを変更

1.フローチャート編集用ユーザーフォームの呼び出し方変更

昨日は、表示されているユーザーフォームの数で以って、呼び出すか否かを判断していました。それではちょっと乱暴なので、次の通り修正しました。

【クラスモジュール】(EditChartClass)
Private Sub Class_Initialize()
    If EditChartForm.Visible = False Then
        EditChartForm.Show vbModeless
    End If
End Sub

実は

If EditChartForm.Visible = False Then

で無条件で呼び出されてしまうので、ここは後日、さらに修正が必要です。

2.オートシェイプリスト用配列のRedim追加

先日の↓これを盛り込むのを忘れていました。
infoment.hatenablog.com

慌てて追加です。

【クラスモジュール】(EditChartClass)
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
    ' ↓↓今回の修正個所↓↓
    Dim SQC As SequenceClass
    Set SQC = New SequenceClass
        ShapeList = SQC.SpecialRedim(ListBoxSeq, i - 1)
    ' ↑↑今回の修正箇所↑↑
End Function

3.クラスモジュール用変数をユーザーフォームのモジュールレベル変数化

何度も登場する共通の変数ということで、モジュールレベル変数に変更します。必要に応じて初期化します。

【ユーザーフォームのモジュール】(EditChartForm)
Option Explicit
Dim EChC As EditChartClass

変数の名前を変更しましたので(ECC ⇒ EChC)ユーザーフォーム初期化の部分を合わせて修正します(名前を変えるだけなので、掲載は割愛)。

4.リストボックスで項目を選択した際のコードを変更

さて、いよいよ昨日の変更に合わせて機能修正するわけですが、昨日作成したクラスモジュールに色々と委ねてしまったので、修正箇所は「ListBox1_MouseUp」部のみとなっています。考え方としては、以下の通りです。

  • リストボックスで項目が選択されていて、且つ、選択順位が「0」である。
     ⇒ 今回選択された項目ということになる。
     ⇒ 対応するオートシェイプを選択し、選択順序の列を更新する。
  • リストボックスで項目が選択されておらず、且つ、選択順位が「0」ではない。
     ⇒ 今回選択が解除された項目ということになる。
     ⇒ とりあえず、選択順序を0にする。

新規に追加する分には、ただ追加するだけで良いので簡単です。しかし選択解除となると、オートシェイプを個別に解除する手立てが(個人的にまだ見つけられてい)ないので、かなり面倒なことになっています。

  1. 一旦、オートシェイプの選択を全解除する。
  2. 選択されたオートシェイプの個数-1回分だけリスト内を巡回し、リスト内に記載された順番にオートシェイプを再選択する。

以上をまとめると、こんな感じです。

【ユーザーフォームのモジュール】(EditChartForm)
Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
    
    Application.ScreenUpdating = False

    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                If ListBox1.List(i, 2) = 0 Then
                    TargetShape(ListBox1.List(i, 1)).Select False
                    EChC.UpdateOrder
                    Exit Sub
                End If
            Else
                If ListBox1.List(i, 2) > 0 Then
                    ListBox1.List(i, 2) = 0
                End If
            End If
        Next
    
    Dim j As Long
    Dim jMax As Long
        On Error GoTo er:
        jMax = EChC.TotalSelectionNumber
        Range("A1").Select
        For j = 1 To jMax
            For i = 0 To ListBox1.ListCount - 1
                If ListBox1.List(i, 2) = j Then
                    TargetShape(ListBox1.List(i, 1)).Select False
                End If
            Next
        Next
        EChC.UpdateOrder
    Application.ScreenUpdating = True
    Exit Sub
    
er:
    Application.ScreenUpdating = True
        
End Sub

結果

オートシェイプの直接選択と、ユーザーフォームのリストボックスによる選択が、両方可能になりました。
f:id:Infoment:20180926070133p:plain

(静止画像だと伝わりにくい)

次回に続きます。

参考まで。