線を引いて動かす ④ 始点と終点を引数とした関数化

ある理由から唐突に、Excelで線を引いて、それを動かしたくなった。
前回は移動前と移動後の線を決めて、そこに至る経過を連続的に描画してみた。
infoment.hatenablog.com

今日は、これを関数にしてみよう。
f:id:Infoment:20200908220619p:plain

今回の作戦は、こうだ。

少々細切れになるが、線を引く部分を関数にする。
移動前の線と移動後の線の始点と終点を、それぞれ配列で渡してみる。

まず、線を引く関数がこちら。

Function GetLine(Sx As Double, _
                 Sy As Double, _
                 Ex As Double, _
                 Ey As Double) As Shape
    Set GetLine = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, _
                                                  Sx, Sy, _
                                                  Ex, Ey)
End Function

　
　
次いで、これを指定分割数で連続的に描画するのがこちら。

Sub MoveLine(ByVal start_position_array As Variant, _
             ByVal end_position_array As Variant, _
             Optional moving_times As Long = 30)

    ' 始点のx,y座標。
    Dim Sx() As Double: ReDim Sx(moving_times)
    Dim Sy() As Double: ReDim Sy(moving_times)
    ' 終点のx,y座標
    Dim Ex() As Double: ReDim Ex(moving_times)
    Dim Ey() As Double: ReDim Ey(moving_times)
    
    ReDim Preserve start_position_array(1 To UBound(start_position_array) - LBound(start_position_array) + 1)
    ReDim Preserve end_position_array(1 To UBound(end_position_array) - LBound(end_position_array) + 1)
    
        ' 初期値設定
        Sx(0) = start_position_array(1)
        Sy(0) = start_position_array(2)
        Ex(0) = start_position_array(3)
        Ey(0) = start_position_array(4)
    
    ' 移動後の座標設定。
        Sx(moving_times) = end_position_array(1)
        Sy(moving_times) = end_position_array(2)
        Ex(moving_times) = end_position_array(3)
        Ey(moving_times) = end_position_array(4)
        
    ' 一回当たりの移動量（始点）
    Dim dSx As Double
        dSx = (Sx(moving_times) - Sx(0)) / moving_times
    Dim dSy As Double
        dSy = (Sy(moving_times) - Sy(0)) / moving_times

    ' 一回当たりの移動量（終点）
    Dim dEx As Double
        dEx = (Ex(moving_times) - Ex(0)) / moving_times
    Dim dEy As Double
        dEy = (Ey(moving_times) - Ey(0)) / moving_times

    ' 線を描画。
    Dim myLine() As Shape
    ReDim myLine(moving_times)
    
    Dim i As Long
        For i = 1 To moving_times - 1
            Sx(i) = Sx(i - 1) + dSx
            Sy(i) = Sy(i - 1) + dSy
            Ex(i) = Ex(i - 1) + dEx
            Ey(i) = Ey(i - 1) + dEy
        Next
    
    ' 設定した移動回数で変形。
        For i = 0 To moving_times
'            If i >= 1 Then myLine(i - 1).Delete
            Set myLine(i) = GetLine(Sx(i), Sy(i), Ex(i), Ey(i))
            Application.Wait [Now() + "00:00:00.03"]
        Next
End Sub

　
それでは、テストしてみよう。
移動後の線を開始線として、次々と線を引いてみた。

Sub test()
    Dim StartArray(1 To 4) As Variant
    Dim EndArray(1 To 4) As Variant
    Dim tempArray As Variant
    Dim i As Long
    Dim j As Long
        For j = 1 To 10
            tempArray = EndArray
            For i = 1 To 4
                StartArray(i) = tempArray(i)
                EndArray(i) = WorksheetFunction.RandBetween(0, 1000)
            Next
            MoveLine StartArray, EndArray
        Next
End Sub