Adding a gif in excel file linked with data validation

[skf786]

My excel file has a drop down list that changes my dashboard accordingly. The file is heavy and the dashboard takes 12 seconds to load each time a user selects an entry from the drop down menu. I would like to show a processing bar gif file during these 12 seconds which should then disappear! After 12 seconds.

thanks in advance!

 

[portews]

Here's code that will add a web browser to your page to display an animated gif. The Sub will create an OLE object of a web browser and show the animated gif in it. The Pause function is a delay timer that will give you the 12 seconds you're looking for, but will not interrupt other processes.

I don't like this method. It looks ugly. I don't see a way of getting rid of the scroll bars and the sunken look. But you asked for it so here it is. Other options follow.

Sub InsertAmGif()
Dim myWebBrowser


Sheet2.Activate


Set myWebBrowser = Sheet1.OLEObjects.Add(ClassType:="Shell.Explorer.2", _
                   Left:=147, Top:=60.75, Width:=350, Height:=100)


myWebBrowser.Object.Navigate "C:\Users\Bill\Downloads\animated-overlay.gif"
Sheet1.Activate [COLOR=#00ff00]'switching back to the sheet seems to[/COLOR]
[COLOR=#00ff00]'               '   trigger the display of the object[/COLOR]


Pause (12)
Sheet1.OLEObjects(1).Delete


End Sub

Public Function Pause(NumberOfSeconds As Variant)
[COLOR=#00ff00]'http://stackoverflow.com/questions/6960434/timing-delays-in-vba[/COLOR]
    On Error GoTo Error_GoTo


    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant


    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
[COLOR=#00ff00]            ' Crossing midnight[/COLOR]
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop


Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function

As an alternative, the simplest way to show something is processing is to set the hourglass icon before you do your recalc and return it to normal afterwards.

Application.Cursor = xlWait

[COLOR=#00ff00]'code goes here[/COLOR]
 
Application.Cursor = xlDefault

If you want a progress bar, make one that works. This one is still a cheat, in my mind, because it is progressing by seconds, not by actual progress, but at least it gives the user the illusion of some sort of measured progress rather than just the hourglass. It's even better if you can trigger the bar from within code, but if you're just waiting for a recalc, I think timing is the best you can do.

This is a Userform called frmProgressBar with two labels in it. One shows the progress in words ("32% Completed") called lblStatus, the other, ProcessBar, acts as the bar itself. For this bar, the background color is whatever you want it to be (I used blue) that makes it stand out. I made it sunken and put a frame around it to help make it stand out more. Make the bar 200 pixels wide. That will make it wide enough to see and easily divisible by 100 to calculate the percentage.

In the code, the width of the bar expands by the Width command each time the code loops thru, waiting one second to continue. It uses the same Pause function as above to get the 1 second timing.

Sub ProgressBar()
Dim i As Integer
Dim barwidth As Long
Dim RunLength As Integer
[COLOR=#00ff00]'show the userform[/COLOR]
frmProgressBar.Show
[COLOR=#00ff00]'in case you want to change the time[/COLOR]
RunLength=12
    With frmProgressBar
        .Caption = "Please wait"
            For i = 1 To RunLength
                [COLOR=#00ff00]'calculate the bar width for each iteration. In this case, 1/12th of the width times the loop number, times the overall bar width, which is 200[/COLOR]
                barwidth = (1 / RunLength) * i * 200
                [COLOR=#00ff00]'set the bar width[/COLOR]
                .ProcessBar.Width = barwidth
                [COLOR=#00ff00]'since the bar is 200, the percentage is always 1/2 the barwidth.  In case of odd numbers of loops, I make it show as an integer, rather than decimal.[/COLOR]
                .lblStatus.Caption = Int(barwidth / 2) & " % Progress: "
                Pause (1)
            Next
    End With
Unload frmProgressBar
End Sub


Public Function Pause(NumberOfSeconds As Variant)
[COLOR=#00ff00]'http://stackoverflow.com/questions/6960434/timing-delays-in-vba[/COLOR]
    On Error GoTo Error_GoTo


    Dim PauseTime As Variant
    Dim Start As Variant
    Dim Elapsed As Variant


    PauseTime = NumberOfSeconds
    Start = Timer
    Elapsed = 0
    Do While Timer < Start + PauseTime
        Elapsed = Elapsed + 1
        If Timer = 0 Then
[COLOR=#00ff00]            ' Crossing midnight[/COLOR]
            PauseTime = PauseTime - Elapsed
            Start = 0
            Elapsed = 0
        End If
        DoEvents
    Loop


Exit_GoTo:
    On Error GoTo 0
    Exit Function
Error_GoTo:
    Debug.Print Err.Number, Err.Description, Erl
    GoTo Exit_GoTo
End Function