کد:
Option Explicit
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID1 As Long
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Static t As Single, t2 As Single, t3 As Single
Dim y As Single
Dim x As Single
Dim x2 As Single
Dim v As Single
On Error Resume Next
t = t + 0.5
t2 = t2 + 0.5
t3 = t3 + 0.5
y = -3.8 * t ^ 2 + 65 * t
x = -200 + t2 * 3.5
x2 = Range("b1").Left + 10 * t3
If y < 0 Then
t = 0
y = 0
End If
If x > Range("L4").Left Then
x = -200
t2 = 0
End If
If x2 > Range("k1").Left Then
t3 = 0
End If
Sheet1.Shapes("Ball").Top = (Range("f30").Top - Sheet1.Shapes("Ball").Height) - y
Sheet1.Shapes("Ball").Left = x2
Sheet1.Shapes("Cloud1").Left = x
Sheet1.Shapes("Cloud2").Left = x + 120
Sheet1.Shapes("Cloud3").Left = x + 210
If Rnd < 0.5 Then
With Sheet1.Shapes("Sun").GroupItems(1).Fill
.ForeColor.SchemeColor = IIf(.ForeColor.SchemeColor = 51, 13, 51)
.Visible = msoTrue
.Solid
End With
End If
End Sub
Sub KillTmr(ByRef ID As Long)
If ID <> 0 Then
KillTimer 0&, ID
ID = 0
End If
End Sub
انیمیشن در اکسل (ایجاد آبجکت های متحرک در اکسل)
پاسخ با نقل قول
علاقه مندی ها (Bookmarks)