انیمیشن در اکسل (ایجاد آبجکت های متحرک در اکسل)

[Amir Ghasemiyan]

سلام دوستان

در این تاپیک میخوام یک آموزش خیلی حرفه ای از کدنویسی vba رو خدمتتون توضیح بدم

شما با کمک این کد قادرید آبجکت های متحرک بسازید و در واقع آبجکت های داخل فایلتون رو متحرک کنید یا به عبارتی انیمیشن ایجاد کنید. در این فایل که به پیوست تقدیم میکنم از قابلیت تایمر استفاده شده و از دو api ویندوز کمک گرفته شده.

بخش اصلی کد مربوط به فایل رو اینجا میذارم:



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




توجه داشته باشید که این فایل یک نمونه خیلی خوب برای اینه که بدونیم با کمک vba چه کارهایی میشه در اکسل انجام داد. یک توپ و سه ابر متحرک و یک خورشید درخشان مثال هایی هست که در این فایل به خوبی ازش استفاده شده. حتما ایده های قشنگی از این فایل خواهید گرفت


15395

[zxcvbn]

سلام دوست عزیز
باید چیز جالبی باشه ولی این برای ویندوز 32 بیت نوشته شده و در ویندوز 64 بیت erroe میده
یه لطفی کن هم نسخه 64 بیتی رو بزارید و هم اینکه نحوه ی تبدیل 32 به 64 رو توضیح بدید
مرسی

[Amir Ghasemiyan]

سلام دوست عزیز
باید چیز جالبی باشه ولی این برای ویندوز 32 بیت نوشته شده و در ویندوز 64 بیت erroe میده
یه لطفی کن هم نسخه 64 بیتی رو بزارید و هم اینکه نحوه ی تبدیل 32 به 64 رو توضیح بدید
مرسی

سلام عزیز
من سیستمم ۶۴ بیتی هست و بدون ارور اجرا میشه. چه خطایی میده؟ دیباگ کنید ببینید کدوم خط ارور میده

[restcafe]

سلام عزیز
من سیستمم ۶۴ بیتی هست و بدون ارور اجرا میشه. چه خطایی میده؟ دیباگ کنید ببینید کدوم خط ارور میده

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