Duplicateで旋回運動の続き（失敗談） - Infomentのブログ～Excel VBA奮闘記～

昨日は、オートシェイプを複製しながらグルグルと回して遊んでみた。
infoment.hatenablog.com
そこで、さらに汎用性を持たせるために、まずクラスモジュールに移植してみた。

クラスモジュール（DuplicateShapeClass）

Option Explicit

Function GetRadius(x0 As Double, y0 As Double, x1 As Double, y1 As Double) As Double
    GetRadius = ((x0 - x1) ^ 2 + (y0 - y1) ^ 2) ^ 0.5
End Function

Function Getθ(x0 As Double, y0 As Double, x1 As Double, y1 As Double) As Double
    Dim dx As Double
        dx = x1 - x0
    Dim dy As Double
        dy = y1 - y0
        Getθ = WorksheetFunction.Atan2(dx, dy)
End Function

Sub RotateShape(Optional rotation_number As Long = 1, _
                Optional rotation_angle As Double = 5)

    Dim iMax As Long
        iMax = rotation_number * 360 / rotation_angle
    Dim Shapes() As Shape
    ReDim Shapes(iMax)
    
    Set Shapes(0) = ActiveSheet.Shapes.AddShape(msoShapeOval, 300, 300, 30, 30)
        Shapes(0).ShapeStyle = msoShapeStylePreset37
        
    Dim x0 As Double: x0 = 500
    Dim y0 As Double: y0 = 500
    
    Dim x1 As Double
    Dim y1 As Double
    
    Dim r As Double
    Dim after_image As Long
        after_image = 10
        
    Dim θ As Double
    Dim dx As Double
    Dim dy As Double
    
    Dim i As Long
        For i = 1 To iMax + after_image
            If i <= iMax Then
                Application.Wait [now()+"0:00:00.01"]
                Set Shapes(i) = Shapes(i - 1).Duplicate
                Shapes(i - 1).Fill.Transparency = 0.8
                x1 = Shapes(i - 1).Left + 15
                y1 = Shapes(i - 1).Top + 15
        
                r = GetRadius(x0, y0, x1, y1)
                θ = Getθ(x0, y0, x1, y1)
                dx = r * (Cos(θ - rotation_angle * WorksheetFunction.Pi / 180) - Cos(θ))
                dy = r * (Sin(θ - rotation_angle * WorksheetFunction.Pi / 180) - Sin(θ))
            
                Shapes(i).IncrementLeft dx
                Shapes(i).IncrementTop dy
            End If
            
            If i >= after_image Then
                Application.Wait [now()+"0:00:00.01"]
                Shapes(i - after_image).Delete
            End If
        Next

End Sub

取り敢えず旋回する回数と、一回に動く角度を変数にしてみた。

Sub hoge()
    Dim DSC As DuplicateShapeClass
    Set DSC = New DuplicateShapeClass
        DSC.RotateShape 2, 5
        DSC.RotateShape 2, 10
        DSC.RotateShape 2, 15
End Sub