シートとユーザーフォームの両方でオートシェイプを選択する
昨日は思い立って、シート上で直接オートシェイプを選択した結果を、ユーザーフォームのリストボックスに反映してみました。
今日は、昨日の結果壊れてしまった、「リストボックスでの選択」機能の復元に挑戦です。
今日やりたいこと
まず、昨日の内容の内容を3点修正します。
次いでユーザーフォームの中身を、オートシェイプ直接編集の仕様に合わせて修正します。
必要なこと
- フローチャート編集用ユーザーフォームの呼び出し方変更
- オートシェイプリスト用配列のRedim追加
- クラスモジュール用変数をユーザーフォームのモジュールレベル変数化
- リストボックスで項目を選択した際のコードを変更
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回分だけリスト内を巡回し、リスト内に記載された順番にオートシェイプを再選択する。
以上をまとめると、こんな感じです。
【ユーザーフォームのモジュール】(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
結果
オートシェイプの直接選択と、ユーザーフォームのリストボックスによる選択が、両方可能になりました。
(静止画像だと伝わりにくい)
次回に続きます。
参考まで。