Sub FireworkAnimation()
Dim fireworkShape As Shape
Dim centerX As Single, centerY As Single
Dim angle As Single
Dim speedX As Single, speedY As Single
Dim steps As Integer
Dim colorR As Integer, colorG As Integer, colorB As Integer
Dim i As Integer, j As Integer
Dim particleCount As Integer
Dim particles() As Shape
Dim speedsX() As Single, speedsY() As Single
Dim ballSize As Single
' Set the active sheet as the canvas
Dim canvas As Worksheet
Set canvas = ActiveSheet
' Clear any existing shapes
On Error Resume Next
canvas.Shapes.SelectAll
Selection.Delete
On Error GoTo 0
' Firework center position
centerX = 400
centerY = 300
' Number of particles per firework
particleCount = 20
' Particle attributes
steps = 50
ballSize = 15 ' Increased size for the particles
' Initialize particle and speed arrays
ReDim particles(1 To particleCount)
ReDim speedsX(1 To particleCount)
ReDim speedsY(1 To particleCount)
' Randomize the color for all particles
colorR = Int(Rnd() * 255)
colorG = Int(Rnd() * 255)
colorB = Int(Rnd() * 255)
' Create particles and their corresponding speeds
For i = 1 To particleCount
angle = Rnd() * 2 * 3.14159
speedX = Cos(angle) * (Rnd() * 10 + 5)
speedY = Sin(angle) * (Rnd() * 10 + 5)
' Add a shape (circle) for each particle
Set fireworkShape = canvas.Shapes.AddShape(msoShapeOval, centerX, centerY, ballSize, ballSize)
fireworkShape.Fill.ForeColor.RGB = RGB(colorR, colorG, colorB)
fireworkShape.Line.Visible = msoFalse
' Store the shape and its speeds in the arrays
Set particles(i) = fireworkShape
speedsX(i) = speedX
speedsY(i) = speedY
Next i
' Animate all particles simultaneously
For j = 1 To steps
For i = 1 To particleCount
With particles(i)
.Left = .Left + speedsX(i)
.Top = .Top + speedsY(i)
.Fill.Transparency = j / steps ' Gradually fade out
End With
Next i
DoEvents
Next j
' Remove all shapes after animation
For i = 1 To particleCount
particles(i).Delete
Next i
End Sub
