I want to use the statusbar for update Information during long calculations in Word. However, the statusbar flickers and switches back to the "normal" statusbar during calculations.
Example:
Sub main()
Dim i As Integer
Dim j As Long
Dim dummy As Double
For i = 1 To 100
Application.StatusBar = "Please be patient... i=" & i
' waiting loop: Flickering due to calculations
For j = 1 To 90000
dummy = Sqr(j) ^ 3
dummy = Sqr(dummy)
Next
' just waiting: (almost) No flickering
'CreateObject("Excel.Application").Wait (Now + TimeValue("00:00:01"))
Next
Application.StatusBar = False
End Sub
If you change the waiting loop with the commended CreateObject..., the flickering is almost gone. I tried also Application.ScreenUpdating but it doesn't work.
How can I stop the flickering during the calculations?
The status bar is flickering because you’ve including its updating in the loop. In effect, it repaints itself on each iteration.
Move it out of the loop and then obviously don’t include the variable “i”.
Another workaround is to put a condition in the loop that checks the counter and only repaints the status bar at 25% done, 50% done and 75% done time frames.
Related
My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.
What can I do to force a screen update?
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.......
Next i
I'm using Excel 2003.
Add a DoEvents function inside the loop, see below.
You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 10000
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
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
This worked for me:
ActiveWindow.SmallScroll down:=0
or more simply:
ActiveWindow.SmallScroll 0
I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful.
Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 1
Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
Case 1, -1
End Select
I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True
In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.
This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.
None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit
Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.
I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with
doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.
I took out the Wait and reset ScreenUpdating and EnableEvents back to true.
This works office excel 2002 through to office 365
Sub Sheet1Mess(Mess1 As String)
Sheet1.Range("A6").Value = Mess1
ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
' Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
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 am supposed to export some large data ranges from Excel to Powerpoint, one page per slide, and of course I should treat the page breaks to avoid "orphan" rows or columns.
I am trying to check how many pages I would have, vertically and horizontally, with a given zoom, by reading HPageBreaks.Count and VPageBreaks.Count, and then manually define the position of each break. The idea is to have approximately the same width and height on each page.
When I debug my code step-by-step, it runs nicely, and the logic seems ok, but if I run it "freely", the page breaks are completely off. Adding some MsgBox instructions, I can see that when I read HPageBreaks.Count (or vertical) I get the wrong values. (I can check the correct ones if I do manually what the code should do).
Searching on many many forums, I see some ugly workarounds like forcing a reset of PaperSize (ws.PageSetup.PaperSize = ws.PageSetup.PaperSize). After trying some of them, what seemed to work a bit better was to turn off PrintCommunication before a change to PageSetup, and then turn it back on. This worked well on most of my sheets, but on the really large ones (~750 rows x 80 columns, almost all cells with formulas), it simply doesn't.
Here an extract of the code:
'Reset page breaks
.ResetAllPageBreaks
'Set minimum acceptable zoom factor
Application.PrintCommunication = False 'This is the ugly workaround
.PageSetup.Zoom = 60
Application.PrintCommunication = True
MsgBox "Zoom = " & .PageSetup.Zoom 'Only for debugging
'Calculate the number of pages in width
Application.PrintCommunication = False
NPagesWide = .VPageBreaks.Count + 1
Application.PrintCommunication = True
MsgBox "NPagesWide = " & NPagesWide
'Find the higher zoom factor that can fit that number of pages
Application.PrintCommunication = False
.PageSetup.Zoom = 100
Application.PrintCommunication = True
Do While .VPageBreaks.Count > NPagesWide - 1
Application.PrintCommunication = False
.PageSetup.Zoom = .PageSetup.Zoom - 5
Application.PrintCommunication = True
Loop
MsgBox "Zoom = " & .PageSetup.Zoom
'Set average width per page and initialize column pointer
If HasTitleColumns Then 'Defined earlier
PageWidth = (PrintArea.Width + TitleColumns.Width * (NPagesWide - 1)) / NPagesWide
j = TitleColumns.Columns(TitleColumns.Columns.Count).Column + 1
Else
PageWidth = PrintArea.Width / NPagesWide
j = 1
End If
'Cycle vertical page breaks
For i = 1 To NPagesWide - 1
'Set width of TitleColumns
If HasTitleColumns Then
CumulWidth = TitleColumns.Width
Else
CumulWidth = 0
End If
'Cumulate columns width until the available page width
Do While CumulWidth + .Columns(j).Width <= PageWidth
CumulWidth = CumulWidth + .Columns(j).Width
j = j + 1
Loop
'Add the break
.VPageBreaks.Add .Columns(j + 1)
Next i
Any ideas why this happens, and how can I solve it?
Thanks,
I propose general advice to the issue when VBA code works fine while hitting F8 in the debug mode, but it doesn't not work after hitting F5 to run the whole macro.
Hint 1. Use ThisWorkbook.ActiveSheet instead of ActiveWorkbook.ActiveSheet whenever possible to reference the proper sheet. Use ThisWorkbook.Application instead of just Application. It could be that you have another Addin program working on in background, switching ActiveSheet to something else that you may not be aware of. Check other macros enabled and get rid of anything that you do not use. So before anything important in your code, try to get the focus for your sheet with ThisWorkbook.Activate. See the graph on that page: http://analystcave.com/vba-tip-day-activeworkbook-vs-thisworkbook/
Hint 2. Force Excel to wait in different way then DoEvents.
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'Place this line of code at the very top of module
Sleep 1 'This will pause execution of your program for 1 ms
https://stackoverflow.com/a/3891017/1903793
https://www.fmsinc.com/microsoftaccess/modules/examples/AvoidDoEvents.asp
Or alternatively:
Application.Calculate
If Not Application.CalculationState = xlDone Then
DoEvents
End If
https://stackoverflow.com/a/11277152/1903793
Hint 3. If the above still does not work for refreshing use:
ThisWorkbook.Connections("ConectionName").Refresh
ThisWorkbook.Application.CalculateUntilAsyncQueriesDone
https://stackoverflow.com/a/26780134/1903793
Another workaround for me was to set the PrintArea new (without .PrintCommunication = false)
wks.PageSetup.PrintArea = wks.PageSetup.PrintArea
This workaround does not affect any pagesetup settings (unlike the .Zoom property)
The problem only occurs if the PageView is set to xlPageLayoutView and there is data "outside" the printarea (UsedRange is larger than PrintArea) when running the macro.
So you can check if the sheet is in PageLayoutView before you do the workaround. If the sheet is in any other view the pagebreaks.count always works fine here.
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.)
My Excel tool performs a long task, and I'm trying to be kind to the user by providing a progress report in the status bar, or in some cell in the sheet, as shown below. But the screen doesn't refresh, or stops refreshing at some point (e.g. 33%). The task eventually completes but the progress bar is useless.
What can I do to force a screen update?
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.......
Next i
I'm using Excel 2003.
Add a DoEvents function inside the loop, see below.
You may also want to ensure that the Status bar is visible to the user and reset it when your code completes.
Sub ProgressMeter()
Dim booStatusBarState As Boolean
Dim iMax As Integer
Dim i As Integer
iMax = 10000
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
Text boxes in worksheets are sometimes not updated
when their text or formatting is changed, and even
the DoEvent command does not help.
As there is no command in Excel to refresh a worksheet
in the way a user form can be refreshed, it is necessary
to use a trick to force Excel to update the screen.
The following commands seem to do the trick:
- ActiveSheet.Calculate
- ActiveWindow.SmallScroll
- Application.WindowState = Application.WindowState
Put a call to DoEvents in the loop.
This will affect performance, so you might want to only call it on each, say, 10th iteration.
However, if you only have 30, that's hardly an issue.
#Hubisans comment worked best for me.
ActiveWindow.SmallScroll down:=1
ActiveWindow.SmallScroll up:=1
Specifically, if you are dealing with a UserForm, then you might try the Repaint method. You might encounter an issue with DoEvents if you are using event triggers in your form. For instance, any keys pressed while a function is running will be sent by DoEvents The keyboard input will be processed before the screen is updated, so if you are changing cells on a spreadsheet by holding down one of the arrow keys on the keyboard, then the cell change event will keep firing before the main function finishes.
A UserForm will not be refreshed in some cases, because DoEvents will fire the events; however, Repaint will update the UserForm and the user will see the changes on the screen even when another event immediately follows the previous event.
In the UserForm code it is as simple as:
Me.Repaint
This worked for me:
ActiveWindow.SmallScroll down:=0
or more simply:
ActiveWindow.SmallScroll 0
I couldn't gain yet the survey of an inherited extensive code. And exact this problem bugged me for months. Many approches with DoEnvents were not helpful.
Above answer helped. Placeing this Sub in meaningful positions in the code worked even in combination with progress bar
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
End Sub
This is not directly answering your question at all, but simply providing an alternative. I've found in the many long Excel calculations most of the time waiting is having Excel update values on the screen. If this is the case, you could insert the following code at the front of your sub:
Application.ScreenUpdating = False
Application.EnableEvents = False
and put this as the end
Application.ScreenUpdating = True
Application.EnableEvents = True
I've found that this often speeds up whatever code I'm working with so much that having to alert the user to the progress is unnecessary. It's just an idea for you to try, and its effectiveness is pretty dependent on your sheet and calculations.
On a UserForm two things worked for me:
I wanted a scrollbar in my form on the left. To do that, I first had to add an Arabic language to "Change administrative language" in the Language settings of Windows 10 (Settings->Time & Language->Change Administrative Language). The setting is actually for "Change the language of Non-Unicode Programs," which I changed to Arabic (Algerian). Then in the properties of the form I set the "Right to Left" property to True. From there the form still drew a partial ghost right scrollbar at first, so I also had to add an unusual timed message box:
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 10 seconds
AckTime = 1
Select Case InfoBox.Popup("Please wait.", AckTime, "This is your Message Box", 0)
Case 1, -1
End Select
I tried everything to get the screen to redraw again to show the first text box in it's proper alignment in the form, instead of partially underneath or at least immediately adjacent to the scrollbar instead of 4 pixels to the right where I wanted it. Finally I got this off another Stackoverflow post (which I now can't find or I would credit it) that worked like a charm:
Me.Frame1.Visible = False
Me.Frame1.Visible = True
In my case the problem was in trying to make one shape visible and another one invisible on a worksheet.
This is my approach to "inactivating" a button [shape] once the user has clicked it. The two shapes are the same size and in the same place, but the "inactive" version has dimmer colors, which was a good approach, but it didn't work, because I could never get the screen to update after changing .visible = FALSE to = TRUE and vice versa.
None of the relevant tricks in this thread worked. But today I found a solution that worked for me, at this link on Reddit
Essentially you just call DoEvents twice in immediate succession after the code that makes the changes. Now why? I can't say, but it did work.
I've been trying to solve this Force a screen update on a Worksheet (not a userform) for many years with limited success with
doevents and scrolling etc.. This CH Oldie solutions works best with a slight mod.
I took out the Wait and reset ScreenUpdating and EnableEvents back to true.
This works office excel 2002 through to office 365
Sub Sheet1Mess(Mess1 As String)
Sheet1.Range("A6").Value = Mess1
ForceScreenUpdate
End Sub
Sub ForceScreenUpdate()
Application.ScreenUpdating = True
Application.EnableEvents = True
' Application.Wait Now + #12:00:01 AM#
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub