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!

 

[Jaafar Tribak]

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.

Put the code in a STANDARD MODULE

 

[Jaafar Tribak]

Use this code instead of the previous one : (Again in a Standard Module )

' 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(1).Activate
    ActiveSheet.Range("B20").Activate
     ActiveSheet.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]

Great, works awesome !
Thanks

 

[bulevardi]

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

Good job.

AMAS

Seems not easy to make something like that in a popup form.
Let us know if it works !