Duplicateでツインビー（分身） - Infomentのブログ～Excel VBA奮闘記～

昨日は、残像をがあるかの如くオートシェイプをコピーして遊んでみた。
infoment.hatenablog.com
イメージとしては、往年のシューティングゲーム「ツインビー」の分身モード。

そこで今回は、昨日の「決め打ち」部分を減らすことに挑戦する。
f:id:Infoment:20190120101517p:plain

今回の目標は、こんな感じだ。

連続的に色々な方向に動かしたい。
ある範囲内で動かしたい。
動く方向はと距離は、無作為に決定したい。

そこで、このような関数を一つ作ってみた。

動かしたいオートシェイプを引数として受け取る。
RND関数で移動方向と距離をランダムに決定する。
終点に残った最後のオートシェイプを関数にセット。

↓ こんな感じだ。なお、TwinBeeとは別物だけど響きは寄せたいということで、綴り違いのTwinBiiという名前にしてみた。
※クレームが来たら、即改名の用意あり。

' Shape     開始位置のオートシェイプ
' division  目的地までの距離の分割数
' after_image   残像の数
' max_range シートの左上を起点とした可動範囲
Function TwinBii(Shape As Shape, _
                 division As Long, _
                 after_image As Long, _
                 max_range) As Shape
    
    ' 描画するオートシェイプ格納用配列。
    Dim Shapes() As Shape
    ReDim Shapes(division)
    ' 一つ目の楕円を描画。
    Set Shapes(0) = Shape
    
    ' 一回の移動距離を、前後左右でランダムに設定。
    Dim dx As Double
        dx = (Rnd - 0.5) * max_range / division
    Dim dy As Double
        dy = (Rnd - 0.5) * max_range / division
    
        ' 開始位置のオートシェイプが可動範囲外の場合、強制的に戻ってこさせる。
        If Shapes(0).Left >= max_range Then dx = -max_range / 10
        If Shapes(0).Top >= max_range Then dy = -max_range / 10
        
    Dim i As Long
        For i = 1 To division + after_image
            ' オートシェイプのコピー。
            If i <= division Then
                ' 0.03秒停止。
                Application.Wait [now()+"0:00:00.04"]
                ' ｉ－１番目の楕円を元に、ｉ番目の楕円を複製。
                Set Shapes(i) = Shapes(i - 1).Duplicate
                ' ｉ－１番目の楕円の透明度を５０％に変更。
                Shapes(i - 1).Fill.Transparency = 0.5
                ' ｉ番目の楕円の位置を変更。
                With Shapes(i)
                    .IncrementLeft dx
                    .IncrementTop dy
                End With
            End If
            
            ' 残像を削除。
            If i >= after_image + 1 Then
                Application.Wait [now()+"0:00:00.04"]
                Shapes(i - after_image - 1).Delete
            End If
        Next
        
    ' 最後に残ったオートシェイプを、TwinBiiにセット。
    Set TwinBii = Shapes(division)
    
End Function

さて、これを動かすわけだが、今回はついでに色も変えてみた。
色の変更については適当なので、エラーが生じれば無視している。

Sub TwinBii_Test()    
    Dim Shape As Shape
    Set Shape = ActiveSheet.Shapes.AddShape(msoShapeOval, Rnd * 300, Rnd * 300, 30, 30)
        Shape.ShapeStyle = msoShapeStylePreset37
    
    Dim i As Long
    Dim ColorIndex As Long
    
        For i = 1 To 20
            Set Shape = TwinBii(Shape:=Shape, _
                                division:=10, _
                                after_image:=3, _
                                max_range:=300)
            On Error Resume Next
            Shape.ShapeStyle = i
            
            Range("A1") = i & "/20 回目"
        Next
        
        Range("A1") = "おしまい"    
End Sub