Excecl VBA Classic Excel VBA 2010 Excel VBA 365 Excel VBA Examples About Us

Lesson 25 Creating Animation


Besides creating Excel VBA 365 code for mathematical and financial calculations, it is also possible to create some fun applications in Excel VBA 365, including games and animation. Although professionals programmers might not be interested in writing such applications, it is worthwhile trying them out as a hobby and for personal satisfaction.

Animation can be achieved by changing the position of an object continuously using a looping sub procedure. It also involved the use of the DoEvents command. DoEvents is an Excel VBA command that temporarily pauses the execution of the macro to refresh the screen and execute any pending events in Excel.

Two properties that are required to change the positions of the object are the Left and Top properties. The Left property specifies the distance between the left edge of the object in pixel from the left border of the screen and the Top property specifies the distance between the top edge of the object and the top border of the screen.The following code makes the object move from left to right then back to left again repeatedly until the user press the stop button. The reset button moves the object back to the starting position. You need to insert the image control into the spreadsheet in order for this code to work

Example 25.1 Object Moving Left Right

Private Sub CmsStart_Click()

repeat:With VBAProject.Sheet1.Image1
 .Left = .Left + 1
DoEvents
 If .Left > 200 Then .Left = 1
End With
GoTo repeat

End Sub

The code for the reset button is

Private Sub CmdReset_Click()
With VBAProject.Sheet1.Image1
 .Left = 0
End With
End Sub

*The above code reset the position of the image to the far left

Figure 25.1

If you wish to move the object up and down, change the above code by replacing the property Left to Top, the code is as follows:

Example 25.2 Object Moving Up and Down

Private Sub StartButton_Click()
repeat:With VBAProject.Sheet1.Image1
.Top= .Top+ 1
DoEvents
If .Top> 200 Then .Top = 1
End WithGoTo repeat
End Sub

If you wish to make the object move diagonally, then use the properties Top and Left at the same time, as follows:

Private Sub StartButton_Click()
repeat:
With VBAProject.Sheet1.Image1

.Top = .Top + 5
.Left = .Left + 5

DoEvents
If .Top > 200 Then .Top = 1
If .Left > 200 Then .Left = 1

End With

GoTo repeat
End Sub

Example 25.3 Creating a Digital Slot Machine

This is a digital slot machine created using Excel VBA 365. In this example, start MS Excel and click the Developer tab. Click View Code to enter the Visual Basic editor. Insert a UserForm and design the UI for the slot machine. Insert three labels for displaying the digits, one label to display the "Slot Machine " name, two command buttons which is used for spinning and ending the program. We use the Rnd function to generate random numbers from 1 to 9 using the formula Int(Rnd * 9)+1 that will be shown on the three labels.

We use the Do..Loop procedure to generate the random numbers and pause it momentarily between each loop using the DoEvents command. This will create the animation effect, simulating a spinning slotmachine.

We use the If...Then..ElseIf statements to check for JackPot and Mini Jackpots. If all numbers are 7 then it will be the Jackpot, if any two same numbers appear then it will be a mini jackpot.

The Code

Private Sub CommandButton1_Click()
Dim x As Integer

x = 0
Do

x = x + 2

 Label1.Caption = Int(Rnd * 9) + 1
 Label2.Caption = Int(Rnd * 9) + 1
 Label3.Caption = Int(Rnd * 9) + 1
 
DoEvents

Loop Until x = 10000
 If (Label1.Caption = 7) And (Label2.Caption = 7) And (Label3.Caption = 7) Then
 MsgBox ("Congratulations! Your strike the Jackpot")
 ElseIf (Label1.Caption = Label2.Caption) Or (Label1.Caption = Label3.Caption) Or (Label2.Caption = Label3.Caption) Then
  MsgBox ("Your strike the Mini Jackpot")
 End If
 
End Sub

 
Figure 25.2 The Design Interface
Figure 25.3 The Runtime Interface
Figure 25.4 Mini Jackpot Dialogue





Copyright ® 2008 Dr.Liew Voon Kiong . All rights reserved   [Privacy Policy]

Contact: Facebook Page