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

[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 چه کارهایی میشه در اکسل انجام داد. یک توپ و سه ابر متحرک و یک خورشید درخشان مثال هایی هست که در این فایل به خوبی ازش استفاده شده. حتما ایده های قشنگی از این فایل خواهید گرفت

[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