スピンボタンでコネクタの接続位置を変更する の続き

昨日はスピンボタンのupとdownを押すことで、オートシェイプに接続されたコネクタの接続位置を変化させてみました。

infoment.hatenablog.com

今日は、昨日の内容を一部見直しします。

今日やりたいこと

1. ToArrayメソッドの改修
2. スピンボタンのコード修正
3. ユーザーフォーム呼び出し

昨日のコメント欄で、imihitoさんから「ToArray」に関するアドバイスをいただきました。まずはその部分を修正します。

次いで、スピンボタンに関する修正です。実は今回、スピンボタンを初めて使ったのですが、良く調べもせずに設置していました。結果、値が1～100の範囲を超えた場合にそれ以上変化せず、接続の付け替えが起こらない現象が起こっていました。この点を修正します。ついでに、終端についてもスピンボタンを設置します。

最後に、コネクタ修正のユーザーフォーム呼び出しボタンを設置します。

必要なこと

1. クラスモジュールのToArrayメソッド改修
2. スピンボタンのコード改修と追加
3. ユーザーフォーム呼び出しボタンの追加

１．ToArrayメソッドの改修

昨日のコメント欄で、imihitoさんから以下のアドバイスをいただきました。

VBA.Collectionの`.Item()`メソッドは後ろのものに
アクセスするほど速度が遅くなります。

そこで、同アドバイスを参考に、ループをFor Each ～ Next に変更することにしました。

クラスモジュール（SequenceClass）

'［用　途］
'   コレクションを一次元配列に変換する
'［引　数］
'   col as Collection   元データ
'［戻り値］
'   一次元配列
Public Function ToArray(col As Collection) As Variant
    Dim seq As Variant
    ReDim seq(col.Count - 1)
    Dim c As Variant
    Dim i As Long
        i = 0
        For Each c In col
            seq(i) = c
            i = i + 1
        Next    
    ToArray = seq
End Function

２．スピンボタンのコード改修と追加

そもそも、スピンボタンと別の値をグルグル回していたため、スピンボタン自身の値に気づけていませんでした。イミディエイトウィンドウに表示させてみると、下限は 0 、上限は 100 で、それ以上値が変化しないようです。
うまい解決策を思いつけなかったので、次のように処理しました。

1. 初期値を、最大値の半分（＝50）とする。
2. 0 または 100 になった時点で、再び 50 に戻す。

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

〇ユーザーフォームの初期化

Private Sub UserForm_Initialize()
    ' 一旦全てのオートシェイプ選択を解除
    Range("A1").Select

    Dim Shape As Shape
    Dim col As Collection
    Set col = New Collection
        For Each Shape In ActiveSheet.Shapes
            If Shape.Connector = msoTrue Then
                col.Add Shape.Name
            End If
        Next
    
    Dim SQC As SequenceClass
    Set SQC = New SequenceClass
        ListBox2.List = SQC.ToArray(col)
        
        ' ↓今回の追記箇所。
        StartSpinButton.Value = StartSpinButton.Max / 2
        EndSpinButton.Value = EndSpinButton.Max / 2
        
End Sub

〇スピンボタンの値が変化したときの処理

Private Sub StartSpinButton_Change()
    If Not start_shape Is Nothing Then
        SC.myShape.ConnectorFormat.BeginConnect start_shape, StartPosition
    End If
    
    Debug.Print StartSpinButton.Value
    
    ' 今回の追記箇所。
    Select Case StartSpinButton.Value
        Case StartSpinButton.Max, StartSpinButton.Min
            StartSpinButton.Value = StartSpinButton.Max / 2
    End Select
    
End Sub

これを、終端についても設置しました。

Private Sub EndSpinButton_Change()
    If Not end_shape Is Nothing Then
        SC.myShape.ConnectorFormat.EndConnect end_shape, EndPosition
    End If
    
    Select Case EndSpinButton.Value
        Case EndSpinButton.Max, EndSpinButton.Min
            EndSpinButton.Value = EndSpinButton.Max / 2
    End Select

End Sub

Private Sub EndSpinButton_SpinUp()
    EndPosition = EndPosition Mod 4 + 1
End Sub

Private Sub EndSpinButton_SpinDown()
    Select Case EndPosition
        Case 1
            EndPosition = 4
        Case Else
            EndPosition = EndPosition - 1
    End Select
End Sub

３．ユーザーフォーム呼び出し

↓ ここに、コネクタ編集用ユーザーフォーム呼び出しボタンを追加しました。

コネクタがシート上に無い状態で呼び出すと、リストボックスに充てるリスト用配列が空振りになってエラーになるので、その辺りのチェックを盛り込んであります。

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

Private Sub EditConnectorShowButton_Click()
    Dim Shape As Shape
        For Each Shape In ActiveSheet.Shapes
            If Shape.Connector Then
                EditConnectorForm.Show vbModeless
                Exit Sub
            End If
        Next        
        MsgBox "コネクタが存在しません。"
End Sub

結果

スピンボタンが底突きしたり、天井につっかえて停止することが無くなりました。