I have an Excel VBA macro that runs for a long time (potentially for days, it performs data acquisition). It was originally written for Excel 2003 and has custom toolbars and menus.
I recently updated it to use a ribbon interface using RibbonXML.
When the macro is running I want to disable some interface elements (such as "start test"), and enable others (such as the "stop test" button.)
The problem I have is that calls to ribbon.invalidate are only processed after the macro code has run to completion.
You can see this effect quite easily with a simple test program
Sub test()
ribbon.Invalidate
DoEvents
Sleep (5000)
End Sub
A debug.print in the ribbon "getEnabled" callback will be seen to only be actioned at the end of the 5 second sleep.
Is there any way to force a ribbon.Invalidate to be activated there and then?
:: Edit 1 ::
I have created a small demo workbook to ilustrate the issue:
http://www.bodgesoc.org/Button_Demo.xlsm
:: Edit 2 ::
A member of a different forum found a solution, though it is a slightly ugly one.
I guess this can now be marked as "answered" but a more elegant solution would be appreciated.
Application.ScreenUpdating = False
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"",False)"
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"",True)"
Application.ScreenUpdating = True
I don't know if this is any less ugly than what you have, but...
'Callback for Run onAction
Sub Run_r(control As IRibbonControl)
SetRunning "Run_r_procedure"
DoEvents
End Sub
Sub Run_r_procedure()
Dim T As Single
Sheet1.Range("A10").Value = "Run pressed, button states changed, and ribbon invalidated. Waiting 5 seconds in loop"
T = Timer
Do While Timer - T < 5
DoEvents
Loop
Sheet1.Range("A10") = ""
End Sub
And then in SetRunning
Sub SetRunning(ByVal ProcToRun As String)
Sheet1.Range("B1") = "Disabled"
Sheet1.Range("B2") = "Disabled"
Sheet1.Range("B3") = "Enabled"
Sheet1.Range("B4") = "Enabled"
Sheet1.Range("B5") = "Enabled"
Sheet1.Range("B6") = "Enabled"
Sheet1.Range("B7") = "Enabled"
myRibbon.Invalidate
myRibbon.InvalidateControl ("Run")
Application.OnTime Now, ProcToRun
End Sub
So you have to have two procedures per callback - the callback and then whatever SetRunning will call that does the actual work. The code is just as ugly, but the UI is little less strange looking to the user.
Related
I need to cancel button clicks on a Custom Ribbon if code is already running.
The problem: although I can disable the button, clicks are still 'registered' and even though disabled, the corresponding code runs once for each button click.
Public Sub OnActionButton(control As IRibbonControl)
' The following approach fails to prevent code from running
If Not globalEnabled Then Exit Sub
' The following approach fails to prevent code from running
Dim goodToGo as Boolean
GetEnabled control, goodToGo
If Not goodToGo Then Exit Sub
' *********************************************************
' Code Below Here Should NOT Run If Button Was Clicked
' While globalEnabled = False (i.e. code already running)
' *********************************************************
' Disable the Ribbon
globalEnabled = False
RibbonInvalidate
Select Case control.id
Case "btnID"
' doSomething
End Select
' Re-enable the ribbon
globalEnabled = True
RibbonInvalidate
End Sub
Edit: For what its worth, this is how I disable the button:
Public Sub GetEnabled(control As IRibbonControl, ByRef enabled)
' Called by RibbonInvalidate
Select Case control.id
Case "btnID"
enabled = globalEnabled
End Select
End Sub
I can imagine that the first click runs as expected, the second click (which is made while the code corresponding to the first click is running) is 'queued' until the first click is completed. At that time globalEnabled is True again so the checks are ineffective.
I guess I could hide the custom ribbon tab (or replace it with a dummy tab) - but is that really necessary?
Is there an elegant way to cancel a button press?
Edit:
I could add a bunch of doEvents to the code, but slows things down too much.
Edit2:
If I display a message box during code execution then, for some reason, it seems that things work as expected...
In fact... if I display a message box then I don't even need the early exit logic - so weird!
This works, main thing was adding doEvents (or a message box) at the end.
Public Sub OnActionButton(control As IRibbonControl)
' Disable the Ribbon
globalEnabled = False
RibbonInvalidate
Select Case control.id
Case "btnID"
' doSomething
End Select
' Re-enable the ribbon
doEvents ' <-- Adding this fixed the issue for me
' msgbox "finished" ' <-- also works, but pretty annoying ;-)
globalEnabled = True
RibbonInvalidate
End Sub
Im late to the party, but are you declaring GlobalEnabled as a global variable? Because from my understanding and testing (on a similar problem) if it is not explicitly declared as global, each time the ribbon button is clicked, a local variable of GlobalEnabled is created rather than using the value set in the prior run of the macro.
I've written a macro which is time consuming (it works for a few hours); that's why I want to add two things to my UserForm, to manually stopping the macro.
First button starts the macro. Let's assume that that code of this macro looks like:
For i = 1 to 10000
DoEvents
If isCancelled Then Exit Sub
Next i
I was thinking about adding an additional "Stop" button, which changes isCancelled from False to True, but the button is locked and can't be clicked during macro execution. Is there any way to enable this button? Or maybe there is a better way to manually stop the macro?
Conceptually, yes this is possible and can be illustrated with a simple example. This is essentially the type of code you alluded to.
Assume your UserForm has two buttons, which start (or resume) and stop the procedure respectively.
Option Explicit
Public isCancelled As Boolean
Public iVal As Long
Private Sub CommandButton1_Click()
Dim i As Long
If iVal = 0 Then iVal = 1 'Allows the user to resume if it's been "stopped"
isCancelled = False
For i = iVal To 100000
iVal = i
If i Mod 1000 = 1 Then
Debug.Print i
End If
If isCancelled Then
GoTo EarlyExit
Else
DoEvents
End If
Next
EarlyExit:
End Sub
Private Sub CommandButton2_Click()
isCancelled = True
End Sub
Of course, implementing the "continuation" option which I did here is a neat little trick, but it may be increasingly complicated depending on the complexity of your procedure, it's dependencies, etc. and if your form is displayed vbModeless you'll need to ensure the user doesn't alter the environment in such a manner as to introduce a runtime error, etc.
You may also look to optimize your procedure if runtime is several hours.
you need to use DoEvents in the loop to catch user responds.
see this answer, which might help you as well.
Problem
I have a macro (I'll call it launch_macro) which is launched by double-clicking in an Userform ListBox (ListBox1_DblClick).
My problem is that if the user double-click again while the macro is still running, the macro will be launched again as soon as the first execution is finished, regardless of the fact that I'm disabling ListBox while the macro is running.
Code and tests
Private sub ListBox1_DblClick(Byval Cancel as MSForms.ReturnBoolean)
(....Logging...)
If Not Cancel Then
Me.ListBox1.Enabled = False
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
launch_macro
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
Me.ListBox1.Enabled = True
End If
End sub
It seems like Excel records/queues the ListBox1_DblClick events (for future execution) while the associated ListBox is disabled. Why that ? How can I prevent this ?
I also tried with no success :
Locked : Me.ListBox1.Locked = True
Doevents : Adding DoEvents after Me.ListBox1.Enabled = False
EnableEvents :Application.EnableEvents = False
macroLaunched variable :Using a variable to check if the macro is already launched (macroLaunched = True at the beginning of the ListBox1_DblClick event and macroLaunched = False at the end). This doesn't work since the second execution is launched after the end of the first event (thus the variable is set back toFalse). (And setting the variable back to False outside the scope of the Dbl_Click event is not acceptable since the user need to be able to launch the macro immediately again (but just not while the first execution is still running)).
Adding delay (for test purpose only) : I added a 10s delay (Application.Wait) right back after the launch_macro. I then double-clicked twice within 1s. The second execution still launched. I checked by logging : the 2nd ListBox1.Dbl_Click event is 'recorded' by Excel 12s after the first event.
Note : I'm using Office Standard 2013
Current 'solution'
This trick is adapted (to reduce delay) from A.S.H answer :
Private sub ListBox1_DblClick(Byval Cancel as MSForms.ReturnBoolean)
Static nextTime As Single
If Timer < nextTime then
Log_macro "Event canceled because Timer < nextTime : " & Timer
Exit Sub
End if
(....Logging...)
If Not Cancel Then
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
launch_macro
(...DisplayStatusBar / ScreenUpdating / ListBox1.BackColor...)
End If
nextTime = Timer + 0.5
Log_macro "nextTime = " & nextTime
End sub
It 'does the trick' but but I still don't like that ListBox1 is still enabled and Excel is still queueing events, thus I need to estimate how many time the user might Dbl_Click (depending on how long the macro takes) to estimate how much a delay I need (currently 0.5s to be able to handle (and log) at least 10 canceled events). Also, it seems like Excel doesn't really like (in regards to performance) queuing events while the macro is running.
Well I will post my suggestion, I hope you try it because may be it was misunderstood. The idea is that once the macro is finished, we set a delay of n seconds (say 2 seconds) before handling again the double-click event. This way, the dbl-clicks that were queued during the macro's execution are handled with no effect during these two seconds.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Static NextTime As Variant ' Will set a barrier for launching again the macro
If Not IsEmpty(NextTime) Then If Now < NextTime Then Exit Sub
ListBox1.Enabled = False
' Any event code
launch_macro
' ...
ListBox1.Enabled = True
NextTime = Now + TimeSerial(0, 0, 2) ' dbl-click events will have no effects during next 2 seconds
End Sub
You could use a variable to lock the critical section of code for a set amount of time.
The example below locks the critical part of Test() function in Sheet2 of an Excel workbook.
Option Explicit
Private booIsRunning As Boolean
Private Sub Test()
If Not booIsRunning Then
booIsRunning = True
Debug.Print "Hello."
Application.OnTime Now + TimeValue("00:00:02"), "Sheet2.UnlockTest"
End If
End Sub
Public Sub UnlockTest()
booIsRunning = False
End Sub
I have a procedure that consists of several do and for loops and i would like to find an easy way to 'pause' the routine and allow the user to edit the sheet, with a msgbox or userform to resume execution where it left off.
I would like to do something like this
dim pause as boolean
pause=false
For i = 1 To 40
Worksheets("sheet1").Range("A" & i) = i
If i = 20 Then
UserForm1.Show vbmodeless
Pause = true
Do until pause = false
loop
Else
End If
Next i
End Sub
Where the pause condition would be set by a sub on the userform. This do loop just crashes.
Ideally i would like the userform to have buttons that can run subs but also allow direct editing of cells while execution is paused.
Here is a typical control structure that allows the user to perform some actions in the middle of a macro. When the user is done, they run OKToContinue to allow the macro to continue with the second part:
Dim AllowedToContinue As Boolean
Sub FirstPartSecondPart()
AllowedToContinue = False
MsgBox "allow user to perform actions"
Do Until AllowedToContinue
DoEvents
Loop
MsgBox "doing second part"
End Sub
Sub OKToContinuw()
AllowedToContinue = True
End Sub
I want to allow the user to make a selection, run some code, pause for another selection, run more code?
I work with documents with large number of tables that eventually convert to HTML. Sometimes the formatting on two like tables doesn't convert the same. Knowing how the converter works, I'd like to copy all of the formatting data from one table and "paste" it onto another one.
I've the idea of a userform to have the user select something, hit a copy button, select something else and hit a paste button.
The timer function allows you to do this. It may not be the best way to code, but it is the answer to your problem:
'1st code here
Start = Timer
Do While Timer < Start + 10
DoEvents
Loop
'do 2nd code here
DoEvents allows the user to select text, etc. After 10 seconds, the code resumes at "2nd code."
You can use global a global variable:
Public myVar as Variant
Sub fillmyVar()
myVar = Selection
End Sub
Sub doSth()
' use myVar and the new selected text
End Sub
Using the answer from Aaron and incorporating it with a ToggleButton in the Userform you can successfully pause the code. With this you can then work in an additional selection to change the operation.
I originally did not use Global or Public Variables but soon learnt that its easier for passing data between Subs and Userforms
Userform:
Public Sub ToggleButton1_AfterUpdate()
'Program is Paused / Selected to Pause
If ProgBar.ToggleButton1.Value = True Then
'Changing the Text of the Toggle button once the program is selected to Pause
'If program paused then button will display continue
ProgBar.ToggleButton1.Caption = "Continue"
'For Sending to Loop Code
ProgramStatus = "0"
Call LoopCode.PrgStat(ProgramStatus)
End If
'Program is running / Selected to run
If ProgBar.ToggleButton1.Value = False Then
'Changing the Text of the Toggle button once the program is selected to continue
'If program running then button will display pause
ProgBar.ToggleButton1.Caption = "Pause"
'For Sending to Loop Code
ProgramStatus = "1"
Call LoopCode.PrgStat(ProgramStatus)
End If
End Sub
In your Module
Public Status As String
Public Sub PrgStat(ByVal ProgStatus As String)
Status = ProgStatus
End Sub
Sub SomeSub()
Do While
' Some Loop Code Running
If Status = "1" Then
'Toggle Not Pressed
End If
If Status = "0" Then
'Toggle Button Pressed
Do While Status = "0"
'Program will stop here until the togglebutton on the
'userform is pressed again which changes Status = 1
'This is where you can make another selection on the
'userform
DoEvents
Loop
End If
Loop
End Sub