Animation in Excel

[kar6842]

I have an Excel File with macros for collecting data. while the macro is running, i want to display an animation showing the running progress?
how to add it?

[mdmackillop]

Search the KB for Progress. There are a few progress bar samples there.

[Paul_Hossler]

http://xcelfiles.homestead.com/AVI.html

http://xcelfiles.homestead.com/AVI.zip

Shows how to display an AVI file as animation in a Userform

Also has dozens of system and XP AVIs

Worth a look

Paul

[bulevardi]

In this case, to make an animation to show a progress bar, I have this one:

bulevardi.be/?content=scripting&example=exvb4

[vba]
' Sleep function, to get breaks or pause in your animation:

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' begin function, link it with a button to your worksheet:

Sub myfunction()
' adding new worksheet:

Dim newsheet As Worksheet
Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wks.Name = "LOADING"
' configuring worksheet:

Cells.Select
With Selection
.ColumnWidth = 0.4
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Font.Name = "Calibri"
.Font.Size = 8
End With
' make a frame for your progress bar:

Range("J20: DF20").Select
Dim myBorders() As Variant, item As Variant
myBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
For Each item In myBorders
With Selection
.Borders(item).LineStyle = xlContinuous
.Borders(item).Weight = xlMedium
.Borders(item).ColorIndex = xlAutomatic
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
Next item
Cells(1, 1).Select
' start the animation:

For i = 0 To 100
Cells(20, 10 + i).Select
With Selection.Interior
.ColorIndex = 1
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Sleep 150
' an additional counter:

Cells(16, 50).Value = i & "% calculated"
' Show optional messages to your animation:

If i = 2 Then
Cells(18, 55).Value = "Initializing..."
ElseIf i = 15 Then
Cells(18, 55).Value = "Problems loading data..."
ElseIf i = 25 Then
Cells(18, 55).Value = "Error #@66!01!"
ElseIf i = 35 Then
Cells(18, 55).Value = "Fixing ALL the bugs at once."
ElseIf i = 45 Then
Cells(18, 55).Value = "Remain Error"
ElseIf i = 55 Then
Cells(18, 55).Value = "Adjusting Excel for alien attacks."
ElseIf i = 65 Then
Cells(18, 55).Value = "Configuring…"
ElseIf i = 75 Then
Cells(18, 55).Value = "Error !!"
ElseIf i = 85 Then
Cells(18, 55).Value = "reloading..."
End If

Next i
' end animation

Cells(1, 1).Select
Sleep 500
' close worksheet:

Application.DisplayAlerts = False
wks.Delete
Application.DisplayAlerts = True
End Sub

[/vba]

Hopefully suits your needs

[bulevardi]

I added some small changes so you won't see the selected area anymore.
The motion tween is perfect:
bulevardi.be/?content=scripting&example=exvb4