Amir Ghasemiyan
2017/08/17, 18:51
سلام دوستان
در این تاپیک میخوام یک آموزش خیلی حرفه ای از کدنویسی 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
در این تاپیک میخوام یک آموزش خیلی حرفه ای از کدنویسی 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