Adding a gif in excel file linked with data validation

skf786

Board Regular
Joined
Sep 26, 2010
Messages
105
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!
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

portews

Active Member
Joined
Sep 4, 2009
Messages
303
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.

Code:
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.

Code:
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.
Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,216
Messages
5,594,885
Members
413,947
Latest member
gizmolucy

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top