Animation ideas

[aubergenie]

Hi all,

I am very inexperienced with macros, but had a strange idea about writing animations in Excel by writing an automated scroll (please humour me!). For the animation to work, the cells must be scrolled through visibly. I have done this successfully using a continuation of the following but obviously this uses many lines of coding.

Sheets("Sheet1").Select
Range("A1:S36").Select
ActiveWindow.SmallScroll Down:=36
Sheets("Sheet1").Select
Range("A37:S72").Select
ActiveWindow.SmallScroll Down:=36
Sheets("Sheet1").Select
Range("A73:S108").Select
ActiveWindow.SmallScroll Down:=36

I would imagine that there is an incredibly simple loop that I could use. I would like it to stop at the bottom of a sheet. Please could you help?

Any other animation suggestions gratefully received.

Lots of thanks!

 

[bertie]

I hope you are not allergic to flashing screens...

[COLOR=darkblue]Sub[/COLOR] test()
   [COLOR=darkblue]Dim[/COLOR] starts [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] ends [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] lr [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
 
   lr = Range("A" & Rows.Count).Row [COLOR=green]'number of rows in worksheet[/COLOR]
   starts = 1
   ends = 36
   [COLOR=darkblue]Do[/COLOR]
      Sheets("Sheet1").Range("A" & starts & ":S" & ends).Select
      ActiveWindow.SmallScroll Down:=36
      starts = starts + 36
      ends = ends + 36
   [COLOR=darkblue]Loop[/COLOR] [COLOR=darkblue]While[/COLOR] ends < lr
   [COLOR=green]'''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
   Application.StatusBar = "Procedure Complete"
   [COLOR=green]''''''''''''''''''''''''''''''''''''''''''''''[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

 

[Excelestial]

Hahahahaa...i did this accidentally recording a macro (navigating around the sheet like a madwoman during recording). The team got a big kick out of it so I let it stay. Recording a macro for movement....well...it works. lol

 

[aubergenie]

Cheers! (I'll check very carefully that no one I show this to has epilepsy)

 

[bulevardi]

</PRE></P>This is one to make a loading progress bar:

' 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

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

 

[AMAS]

Bulevardi this was neat. I liked it. Just one thing to note that I had to modify your Public declaration because I have a 64-bit system:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

I will try to incorporate this into a progress bar on a form. Looks promising.

Good job.

AMAS

 

[Jaafar Tribak]

lol

I got scared when I ran the code !

Nice idea and great visual effect !!!

 

[bulevardi]

Bulevardi this was neat. I liked it. Just one thing to note that I had to modify your Public declaration because I have a 64-bit system:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

I will try to incorporate this into a progress bar on a form. Looks promising.

Good job.

AMAS

Hmm I see.
Does it work with this:
Private Declare Sub Sleep Lib "kernel64" (ByVal dwMilliseconds As Long)

 

[Jaafar Tribak]

Hey bulevardi

here is a adaptation of your code that uses a Linked Picture in the active sheet - It works very smoothly and you are not distracted by the temporary LOADING sheet

' 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:
 
Public Declare Function LockWindowUpdate Lib "user32.dll" _
(ByVal hwndLock As Long) As Long

Sub myfunction()
' adding new worksheet:
 
    Dim newsheet As Worksheet
    Dim oPicLink As Object
     
     LockWindowUpdate Application.hWnd
    Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
    wks.Name = "LOADING"
' configuring worksheet:
 
'    Cells.Select
    With wks.Cells '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 Range("J20: DF20") '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
    
    Range("J20: DF20").Copy
    Sheets("Sheet3").Activate
    ActiveSheet.Range("B20").Activate
     Sheets("Sheet3").Pictures.Paste(Link:=True).Select
    Set oPicLink = Selection
    LockWindowUpdate 0
    
' start the animation:
 
    For i = 0 To 100
'    wks.Cells(20, 10 + i).Select
    With wks.Cells(20, 10 + i).Interior
        .ColorIndex = 1
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        DoEvents
    End With
    Sleep 150
' an additional counter:
 
    wks.Cells(16, 50).Value = i & "% calculated"
' Show optional messages to your animation:
 
    If i = 2 Then
        Cells(18, 5).Value = "Initializing..."
    ElseIf i = 15 Then
        Cells(18, 5).Value = "Problems loading data..."
    ElseIf i = 25 Then
        Cells(18, 5).Value = "Error #@66!01!"
    ElseIf i = 35 Then
        Cells(18, 5).Value = "Fixing ALL the bugs at once."
    ElseIf i = 45 Then
        Cells(18, 5).Value = "Remain Error"
    ElseIf i = 55 Then
        Cells(18, 5).Value = "Adjusting Excel for alien attacks."
    ElseIf i = 65 Then
        Cells(18, 5).Value = "Configuring…"
    ElseIf i = 75 Then
        Cells(18, 5).Value = "Error !!"
    ElseIf i = 85 Then
        Cells(18, 5).Value = "reloading..."
    End If
 
    Next i
' end animation
 
'    Cells(1, 1).Select
    Sleep 500
' close worksheet:
 

    Application.DisplayAlerts = False
    wks.Delete
    Application.DisplayAlerts = True
           
    oPicLink.Delete
    Cells(18, 5).ClearContents

End Sub

 

[bulevardi]

Hey bulevardi

here is a adaptation of your code that uses a Linked Picture in the active sheet - It works very smoothly and you are not distracted by the temporary LOADING sheet

Hmm, want to try it here but I always get this error:
I'm obviously doing something wrong.

Compile Error:
Constants, fixed-length strings, arrays, user-defined types and Declare statements not allowed as Public members of object modules.