自分が何番目に選ばれたかオートシェイプに記録する

昨日は選択済みオートシェイプについて、一括で形状を変更してみました。

infoment.hatenablog.com

今日は、オートシェイプをコネクタで接続するための下ごしらえに挑戦です。

今日やりたいこと

リストボックス経由で選択されたオートシェイプが「何番目に選択されたか」を、順に配列に格納することで、あたかも、オートシェイプ自身に順番を記録したかのような状態にします。これにより、繰り返し処理が可能になります。

ただし現時点で、リストボックスに記録済みの順番には「欠番」があります。この欠番を連番にしないと、処理が複雑になる恐れがあります。

そこでこの問題解決を含め、以下手順による登録を試みました。

  1. 欠番を解消
  2. オートシェイプを配列にセット
  3. 配列の順にオートシェイプを選択

必要なこと

  1. 欠番を解消する関数の実装
  2. 1. をリストボックスに反映
  3. オートシェイプを順に配列へセット

1.欠番を解消する関数の実装

これについては、先日作成済みです。
infoment.hatenablog.com

実はこの件が切っ掛けで、同関数を作成した次第です。参考までに、こちらに再掲します。

【標準モジュール】
Public Function RankDict(ByVal seq As Variant) As Dictionary
    Dim Dict As Dictionary
    Set Dict = New Dictionary
    
    Dim myMin As Double
        myMin = WorksheetFunction.Min(seq) - 1
    
    Dim i As Long
    Dim j As Long
        j = UBound(seq) - LBound(seq) + 1
        Do
            For i = LBound(seq) To UBound(seq)
                If seq(i) = WorksheetFunction.Max(seq) Then
                    Dict(seq(i)) = j
                    j = j - 1
                    seq(i) = myMin
                    Exit For
                End If
            Next
            If WorksheetFunction.Max(seq) = myMin Then Exit Do
        Loop
        
        Set RankDict = Dict
End Function

2.1.をリストボックスに反映

まず、リストボックス内の項目がいくつ選ばれているか、その個数を取得します。

【ユーザーフォームのモジュール】
Private Function SelectedCounter() As Long
    SelectedCounter = 0
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                SelectedCounter = SelectedCounter + 1
            End If
        Next
End Function

この値と、先ほど再掲した連想配列を組み合わせて、選択順序から欠番を取り除きます。

Private Sub UpdateOrder()
    Dim i As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                If ListBox1.List(i, 2) = 0 Then
                    ListBox1.List(i, 2) = iMax
                End If
            Else
                ListBox1.List(i, 2) = 0
            End If
        Next
' -----------↓↓今回追加した箇所↓↓-----------
    Dim Dict As Dictionary
    Set Dict = RankDict(OrderSeq)
        For i = 0 To ListBox1.ListCount - 1
            Dim myOrder As Long
            myOrder = ListBox1.List(i, 2)
            If Dict.Exists(myOrder) = True And myOrder > 0 Then
                ListBox1.List(i, 2) = Dict(myOrder) - ListBox1.ListCount + SelectedCounter
            End If
        Next
' -----------↑↑今回追加した箇所↑↑-----------        
End Sub

3.オートシェイプを順に配列へセット

順序が重要となるのは、何か順序に関する仕事をさせるときだけです。昨日までにオートシェイプの選択は果たしているので、現時点では未だ、どのプロシージャも組み込み対象となっていません。そこで今回はとりあえず、中身だけ掲載します。

【ユーザーフォームのモジュール】
Private 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

  何かの処理

End Sub

今回の用法で特徴的なのは、オートシェイプの選択がリストボックスの並び順(上から下)である一方、オートシェイプに付された番号が選択された順序である点です。かなり回りくどいという自覚はあるので、いずれ改善したいと思っています。

結果

意図したとおり、欠番が解消されるようになりました。オートシェイプに選択順序を付す準備も完了です。

f:id:Infoment:20180915222339p:plain

  ↓ 「処理3」の選択解除

f:id:Infoment:20180915222409p:plain

次回に続きます。

参考まで。