VBA オートシェイプを使った泡のアニメーション

作り方

まずSheet1のオブジェクト名をプロパティウィンドウからScreenに変更する。

そしてシートモジュールScreenのコードに初期化用のClearプロシージャを用意しておく。

SubClear()Me.Cells.Interior.Color =vbBlackDim sh As Shape
    ForEach sh InMe.Shapes
        sh.DeleteNextEndSub

次にクラスモジュールを挿入し、オブジェクト名をBubbleとする。

クラスのコードはこちら。

OptionExplicitPrivate bubbleShape As Shape
Private speed AsDoublePrivate scales AsDoublePublicFunction Float()AsBooleanIf bubbleShape.Top - speed >0Then
        bubbleShape.IncrementTop -speed
        speed = speed *1.1
        scales = scales *0.99
        bubbleShape.ScaleHeight scales, msoFalse, msoScaleFromMiddle
        bubbleShape.ScaleWidth scales, msoFalse, msoScaleFromMiddle
        Dim c: c =Int((255-100+1)*Rnd+100)
        bubbleShape.Fill.ForeColor.RGB=RGB(c, c, c)
        Float =TrueElse
        Float =FalseEndIfEndFunctionPrivateSub Class_Initialize()Randomize
    speed =5
    scales =1Dim x: x =Int((Application.Width-0+1)*Rnd+0)Dim y: y =Int((Application.Height -200+1)*Rnd+200)Dimsize: size=Int((50-30+1)*Rnd+30)IfInt((1-0+1)*Rnd+0)=1ThenSet bubbleShape = Screen.Shapes.AddShape(msoShapeDonut, x, y,size,size)
        bubbleShape.Adjustments.Item(1)=0.1ElseSet bubbleShape = Screen.Shapes.AddShape(msoShapeOval, x, y,size,size)EndIf
    bubbleShape.Line.Visible = msoFalse
    bubbleShape.Fill.ForeColor.RGB=vbWhite
    bubbleShape.Fill.Transparency =0.1EndSubPublicPropertyGet Self()AsObjectSet Self =MeEndPropertyPrivateSub Class_Terminate()
    bubbleShape.DeleteEndSub

最後にメインプロシージャ用に標準モジュールを挿入する。
このモジュールのオブジェクト名は任意。

標準モジュールに書くコードはこちら。

OptionExplicit#If VBA7 ThenPrivateDeclare PtrSafe Sub Sleep Lib"kernel32"(ByVal ms As LongPtr)#ElsePrivateDeclareSub Sleep Lib"kernel32"(ByVal ms AsLong)#EndIfSub BubbleAnimation()Const BUBBLE_LEVEL =5' 1 to 10
    Screen.ClearDim bubbles As Collection: Set bubbles =New Collection
    Do
        Application.ScreenUpdating =FalseDim i
        For i =1ToInt((BUBBLE_LEVEL -0+1)*Rnd+0)
            bubbles.AddNew Bubble
        NextDim j
        For j = bubbles.CountTo1Step-1IfNot bubbles(j).Float Then
                bubbles.Remove j
            EndIfNext
        Application.ScreenUpdating =True
        Sleep 10DoEventsLoopEndSub

あとはBubbleAnimationを実行すればアニメーションが始まる。
終了方法は用意してないのでVBEの停止ボタンで止めている。

※今回のコードはお遊びなので割とやっつけコーディング。
　そのためマジックナンバーを多用してるが、良い子は真似しないように。