I'm trying to change the text displayed in the status bar in Excel 2015 using VBA. However, it doesn't seem to be updated. The message "Ready" remains there.
Function testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Function
I also tried many answers that where given here on this website for similar questions, however nothing worked. Is something wrong with the code or do I have to change some settings?
Your function works fine, but I suspect that you are calling it as a UDF from an Excel cell. UDFs are not permitted to update the status bar, or make any other changes to the Excel environment. (Basically, a UDF is allowed to return a value and that's it.)
If you called that function from a piece of VBA code, it works OK, providing you change it to return a value such as:
Function testStatusBar(delay As Long) As String
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
testStatusBar = "Finished"
End Function
(You could then call it from other VBA code by saying myReturnValue = testStatusBar(200000)
Or change it to a Sub instead of a Function, i.e.
Sub testStatusBar(delay As Long)
Dim progress As Long
For progress = 1 To delay
Application.StatusBar = "Progress: test ongoing ...." & (progress / delay) & "%"
DoEvents
Next progress
Application.StatusBar = False
End Sub
(and then call it by saying testStatusBar 200000.)
Related
I have this piece of code which I would like to show and hide some Shape objects one by one, in order to make a little animation. However, nothing happens as the code executes, all images are shown by once when the code stops running.
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
Sleep 500
'Sheets("Game").Shapes("North" & i).Visible = False
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
DoEvents
Next i
End Sub
DoEvents allows other code (e.g. Excel's own) to run and handle things like user clicking on another worksheet (which invokes any Worksheet.Change or Workbook.WorksheetChange handler)... or just repainting itself.
By invoking DoEvents once per loop, Excel doesn't get a chance to repaint between the visibility toggles: it's already busy running your loop.
So you need to toggle visibility on, let Excel repaint (DoEvents), sleep for your animation delay (500ms seems a tad slow IMO), then toggle visibility off and let Excel repaint again, i.e. invoke DoEvents one more time.
If the Game worksheet is in ThisWorkbook, then I'd warmly recommend you give it a CodeName - select it in the Project Explorer, then look at its properties (F4) and change its (Name) to, say, GameSheet.
This gives you a global-scope object variable so that you don't need to dereference the same worksheet twice per iteration - heck you could even dereference its Shapes collection only once:
Private Const ANIMATION_DELAY As Long = 100
Sub test()
With GameSheet.Shapes
For i = 1 To 4
Dim currentShape As Shape
Set currentShape = .Item("North" & i)
currentShape.Visible = True
DoEvents
Sleep ANIMATION_DELAY
currentShape.Visible = False
DoEvents
Debug.Print i
Next
End With
End Sub
Amended the code by setting DoEvents after toggling True and Falseand now it works:
Sub test()
For i = 1 To 4
Sheets("Game").Shapes("North" & i).Visible = True
DoEvents
Sleep 100
Sheets("Game").Shapes("North" & i).Visible = False
DoEvents
'by setting it to false i'd like to achieve the animation effect
Debug.Print i
Next i
End Sub
I am trying to work out how to get my progress bar to show the progress of the subroutine below. Does anyone have any ideas how to get the ball rolling on this one?
Any help or advice is appreciated.
Private Sub CommandButton8_Click()
Dim StartTime As Double
Dim MinutesElapsed As String
'Remember time when macro starts
StartTime = Timer
'*****************************
'Direct Data
Sheet4.Activate
Call Test1
Call Test2
Call Test3
Call Test4
'Return to Welcome Page
Sheet8.Activate
'*****************************
'Determine how many seconds the code took to run
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
'Notify user in seconds
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Here's what I use for a progress bar:
Application.StatusBar = "Processing... " & CInt(nRow / nLastRow * 100) & "% " & String(CInt(nRow / nLastRow * 100), ChrW(9609))
DoEvents ' optional
nRow is the increment number
nLastRow is the value for 100% complete
When the loop is complete, reset it like this:
Application.StatusBar = ""
The logic behind a progressbar is this:
have a userform with a Label (or image or button) with the image of your example photo. Put it in a frame. The width of the frame is initialised to zero and grows as your number grows by either calling a Public Sub inside the userform, of directly Userform1.Frame1.width=Percent*MaxWidth/100.
Sometime you would want to add a doevents, wich i use only every X cycles (if clng(percent) mod X = 0 then doevents , for example).
Step 1: design a progress dialog box. For the following example, it must have the name frmProgress and have two text labels lblMsg1 and lblMsg2
Step 2: insert the following code in the dialog's code module:
Sub ShowProgressBox()
Me.Show vbModeless
End Sub
Sub SetProgressMsg(msg1, msg2)
If (msg1 <> "") Then Me.lblMsg1 = msg1
If (msg2 <> "") Then Me.lblMsg2 = msg2
DoEvents
End Sub
Sub SetProgressTitle(title)
Me.Caption = title
DoEvents
End Sub
Sub EndProgressBox()
Unload Me
End Sub
You can call these functions from your code to show progress messages.
Step 3: in your code, at the beginning of the lengthy operation, call
frmProgress.ShowProgressBox
Step 4: during the lengthy operation, regularly call the set function to show the user information, for example in a loop:
frmProgress.SetProgressMsg "Searching in "+ myArray(i), "Working..."
Step 5: Once done, close the progress box:
frmProgress.EndProgressBox
I have some vba code that takes a good minute or so to run in excel and I was trying to add a progress bar or some type of waiting screen to better show to the user that the code is still running correctly. I realize that the ProgressBar can only show true progress in specific types of code, of which I do not believe mine would apply.
However, I was wondering if there was a way to have the ProgressBar just loop and once it is full it starts from the beginning again until my code has finished; in a similar fashion to a charging icon when a phone is plugged in. So upon activating my code, the UserForm1 would pop up and show a repeating ProgressBar and upon completion of my code the UserForm would Unload.
Any suggestions would be helpful.
Thanks!
I use the following for a progress bar on a user form. It consists of a label within a frame; at the beginning the label has width zero and then it widens to fill the frame at 100% completion. The label has no text, but it has a BackColor property set to serve as the bar. There's a second progressText label to the right of the frame. To call this function, use a loop such as i = i + 1 with pctCompl = 100 * i / iTotalNum, and then include in the loop: progress pctCompl, "listing files", and when finished make progress bar invisible with: progress -1. You can always reset it to 0 using pctCompl = 0 at any time.
Sub progress(pctCompl As Integer, Optional msg As String)
Dim increment As Double, i As Integer
If pctCompl < 0 Then
If progressBar.Width < 0.9 * progressFrame.Width Then
progressBar.Width = progressFrame.Width
Application.Wait (Now + TimeValue("0:00:01"))
End If
progressText.Visible = False
progressFrame.Visible = False
Exit Sub
Else
progressText.Visible = True
progressFrame.Visible = True
End If
progressText.Caption = pctCompl & "% " & msg
progressBar.Width = progressFrame.Width * pctCompl / 100
DoEvents
End Sub
Private Sub UserForm_Activate()
progressFrame.Visible = False
progressText.Visible = False
end Sub
I have some long processes that require notifications to the user at successive stages, so that he doesn't get to believe Excel has crashed down.
How could I display asynchronous messages to the user in Excel, using VBA ?
You can use the status bar in Excel to do this:
Application.StatusBar = "status message"
Here is an example on how to implement this: http://www.vbaexpress.com/kb/getarticle.php?kb_id=87
Below is the code from the site (added line break to make is easier to read):
Sub StatusBar()
Dim x As Integer
Dim MyTimer As Double
'Change this loop as needed.
For x = 1 To 250
'Dummy Loop here just to waste time.
'Replace this loop with your actual code.
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03
Application.StatusBar = _
"Progress: " & x & " of 250: " & Format(x / 250, "Percent")
DoEvents
Next x
Application.StatusBar = False
End Sub
UPDATE:
I do want to add that updating the status bar will result in a sizable hit in performance (quite a bit actually), so you should only update it in approriate intervals. Here's an example of what I mean (I use MOD here to ensure we only increment each 1000):
Sub test()
Dim i As Long
Dim temp As String
For i = 1 To 1000000
temp = "testing 123, testing 123"
If i Mod 1000 = 0 Then
Application.StatusBar = "Processing " & i & "/1,000,000..."
End If
Next
Application.StatusBar = "Ready"
End Sub
Also note that you want to reset the text to "Ready" otherwise it'll be left as if it were in the loop.
I've stuck with Walkenbach's progress form for my addins
The following article has a number of ways of doing this: http://oreilly.com/pub/h/2607
I think the best bet for you would be to show a progress form. This can include a progress bar and text updates to reassure the user.
Something I once did was to create an extra tab called "Running".
After each time consuming loop, I add the following code with updated text information.
Although the text sometimes changes too fast, the changing color bar shows the user that the script is still running. You have to define AlertColor first with a value of 6.
Sheets("Running").Select 'Show the running page
Range("B18").Value = "Importing ABC......"
Cells(18, 2).Interior.ColorIndex = AlertColour
AlertColour = AlertColour + 1
If AlertColour > 8 Then AlertColour = 6
Application.ScreenUpdating = True
Application.ScreenUpdating = False
I don't know how far you want to go with your solution, but you can utilise RTD function. That way you could put a status message directly in the worksheet. But it would require development of a COM Automation server, which is not complicated (can be written in .NET or VB6 or C++ or Delphi), but causes problems once in production (deployment, support, code control etc.)
I'm using DoEvents to force an update of a progress indicator in the status bar (or in some cell in the sheet) as in the example code below. But the screen doesn't refresh, or stops refreshing at some point. The task eventually completes but the progress bar is useless.
Why won't DoEvents "do the events"? What else can I do to force a screen update?
Edit: I'm using Excel 2003 on Windows XP.
This is a follow up to an earlier question; thanks to Robert Mearns for his answer and the sample code below.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 100
Application.ScreenUpdating = False
''//Turn off screen updating
booStatusBarState = Application.DisplayStatusBar
''//Get the statusbar display setting
Application.DisplayStatusBar = True
''//Make sure that the statusbar is visible
For i = 1 To iMax ''// imax is usually 30 or so
fractionDone = CDbl(i) / CDbl(iMax)
Application.StatusBar = Format(fractionDone, "0%") & " done..."
''// or, alternatively:
''// statusRange.value = Format(fractionDone, "0%") & " done..."
''// Some code.......
DoEvents
''//Yield Control
Next i
Application.DisplayStatusBar = booStatusBarState
''//Reset Status bar display setting
Application.StatusBar = False
''//Return control of the Status bar to Excel
Application.ScreenUpdating = True
''//Turn on screen updating
End Sub
I've found DoEvents is not always completely reliable. I would suggest trying two different things.
First, try placing the DoEvents call immediately after the Status Bar update (ie, before your Some code .... line).
If that does not work, I've found in some cases that using the Sleep API is a more reliable way to yield processor time. It's usually the first thing I try if DoEvents is not working as I'd like. You'll need to add the following line at the top of your module (outside of your function):
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Then add this line in place of, or in addition to, DoEvents:
Sleep 1 'This will pause execution of your program for 1 ms
You might try increasing the length of time you pause the program using sleep if 1 ms doesn't work.
I've found that calling DoEvents before updating the status bar, rather than after, yields more predictable/desirable results.
The code snippet from above would be:
fractionDone = CDbl(i) / CDbl(iMax)
DoEvents
Application.StatusBar = Format(fractionDone, "0%") & " done..."