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

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

infoment.hatenablog.com

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

今日やりたいこと
必要なこと
結果

今日やりたいこと

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

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

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

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

必要なこと

欠番を解消する関数の実装
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

２．１．をリストボックスに反映

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

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

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

３．オートシェイプを順に配列へセット

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

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

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