I have a subroutine invoked via Application.OnTime scheduled call.
How can I determine with Excel VBA whether the subroutine's workbook is the focused application/process in Windows?
(If it is not the active application then I will run a code that blocks the process for a little bit. If it is active I don't want to do that because I may be doing work in the workbook that I don't want interrupted.)
Try this. I tested it and it seems to work.
On module level:
Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
For testing purposes I wrote these 2 subs:
Sub Test()
If GetActiveWindow <> 0 Then
'Application in focus
Debug.Print "Focus"
Else
'Application not in focus
Debug.Print " No focus"
End If
End Sub
Sub Timer()
Application.OnTime Procedure:="Test", EarliestTime:=Now + TimeValue("00:00:10")
End Sub
Now, try like this:
Run Timer (from the immediate window for example).
Before the timer reaches the 10 seconds set, switch to another app like your internet browser for example. Wait a bit for the time to complete.
Look at what the console displays:
If you stay on the excel window, the console will display "Focus".
If you switch window it will say "No focus".
Related
I have created Drag-n-Drop form for Excel in order to capture link to file location using treeview control (code bellow). It works as intended, however problem that after I make form ShowModal = False (because user might want to move Excel window in order to reach file-to-be-dragged) after it runs it's routine, error message pops-up informing that "File format is not valid" (screen below) or notification that file might be corrupt or unsafe (second screen below).
To my understanding that happens because Excel considers file to be dropped on the sheet and tries to open it (it will be most likely .pdf file).
Is there a way to prevent that other than making form Modal? To my understanding to achieve that somehow error message should be prevented or Excel should not try to open file at all and by doing that avoid message altogether (best case).
Code for Drag-n-Drop functionality:
Private Sub TreeView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
'for capturing draged file path
'VBA does not have normal native functionality to do that so it is solved by using treeview widget unconventionaly
Dim LinkToPass As String
LinkToPass = Data.Files(1)
MsgBox "Thank you! Link captured.", vbInformation, "Link captured"
'Pass information to another form, where user enters all other data required
If formLoaded("NewEntry_agreement") Then
NewEntry_agreement.LinkToFile.Caption = LinkToPass
End If
CloseBtt_Click 'just call close button Sub with Unload Me inside
End Sub
EDIT: Additional info and screenshot about alternative message. Also made goal more clear - either prevent message or prevent Excel from trying to open the file and by doing that prevent error message.
Click the form to toggle modal/modeless
' Adapted from Stephen Bullen's ModelessForm.xls 1998 example
Private Declare PtrSafe Function EnableWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal fEnable As Long) As Long
' click the form to toggle modal/modeless
Private Sub UserForm_Click()
Static lMode As Long
lMode = IIf(lMode = 0, 1, 0)
EnableWindow Application.hwnd, lMode
Me.Caption = IIf(lMode, "Modeless", "Modal")
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
' ensure the app window is reset (maybe trap the state and reset if/as necessary)
EnableWindow Application.hwnd, 1
End Sub
I understand what you describe but I don't think there's a simple solution. Easiest would be if this works -
Call DragAcceptFiles(FindWindow("ThunderDFrame", Me.Caption), 0)
.. but unfortunately it doesn't. Neither does does attempting to disable the xlApp.Hwnd the same way from accepting dropped files. Maybe need to disable one of the other bunch of windows(?), I've only tried the ones I mentioned.
Briefly two different approaches you might look into -
Add a button for the user to toggle modeless / modal before enabling drag files operation. I don't have the code to hand, but it's definitely possible albeit not supported.
Instead of the treeview's OLE-DD setup a callback with CallWindowProc to trap the WM_DROPFILES message, get the files with DragQueryFile, and prevent Excel from receiving the message with DragFinish. You'd need a window and this could be the form's first and only direct Child window. Better though to add a window'd control such as a Frame (though it doesn't directly expose its 'hwnd' so a fair bit of API work to get it). Plenty of general examples out there and I've had this approach working - but unfortunately there are several catches and I don't have anything reliable enough I'd want to post!
This won't be the answer you're looking for but it might be the best you're going to get! Though I'd be pleased to be wrong:)
I'm using an Excel file to operate a small business system and have noticed some quirks with the Workbook_Open() event. The file contains dozens of modules (including class modules representing business logic such as invoices and customers) and I have not been able to reproduce the issue with an MCVE but am hoping someone can help me learn something from this.
The setup is straightforward, the Workbook_Open() event in the ThisWorkbook object calls a sub named Init placed in a regular model called Main:
Private Sub Workbook_Open()
Call Main.Init
End Sub
The Init sub in the Main module prints a start-up message to the immediate window and calls some other subs to initiate a couple of global variables to hold some data:
Public Sub Init()
' Called by ThisWorkbook.Workbook_Open().
Debug.Print "Initializing variables..."
Debug.Print "The system contains:"
Call Init_Items
End Sub
Public Sub Init_Items()
' This sub populates a collection of objects of a CInvoice class by looking
' up data in an Invoices table (a VBA ListObject); it produces output
' similar to the following:
Debug.Print "230 invoices."
End Sub
If the above code is placed in a sample file, it will print the following start-up message to the Immediate window when that file is opened:
Initialzing variables...
The system contains:
230 invoices.
This simple setup basically corresponds to the operational business file. However, when the business file is opened the output is printed twice to the Immediate window. To figure out what's going on, I placed a Stop in Workbook_Open(), in the hope that I could step through the code. To my surprise this revealed that the first iteration of the start-up message was written to the Immediate window even before the call to Main.Init.
Private Sub Workbook_Open()
Stop ' <--- The output produced by Main.Init is written to the
' Immediate window twice, both before and after this Stop.
Call Main.Init
End Sub
Moreover, Workbook_Open() also writes the number 3 to the Immediate window. This 3 is typically written after each iteration of the start-up message, but occasionally the first 3 is written before the first iteration of the start-up message and then after the second iteration. Sometimes it's written only once, after the first iteration of the start-up message but I have not noticed any pattern to this behavior.
This isn't really a big issue since the system is working properly but I'm curious to know what's going on.
I have an Excel macro that I would like to run automatically when the file is opened. The only way I have gotten this to work is by adding a msgbox before calling to my subroutines. However, this requires me to click OK or close the box for the macros to run. I have tried using a timed msgbox sub, but this also does not work.
For some reason, the msgbox pops up before Excel is fully opened, at which point the macro gets stuck here (code for this is below). From here, I tried waiting for the file itself to be opened until it is in write-mode (Workbook.ReadOnly = false). This also did not work.
Public Sub msgBoxTimer()
Const timeout = 2
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
objShell.Popup "Measurement will begin shortly", timeout
End Sub
Private Sub Workbook_Open()
Call msgBoxTimer
Call init ' initiate device
Call updateIndex ' collect & record measurements
End Sub
I get from your comment that you are probably running other shell commands in init and updateIndex.
What needs to be clear is that when you execute a Shell command via a Shell object in VBA, the default behavior is not to wait for the shell command to complete before running the next line of codes.
If you want Excel to wait for the Shell command to be completed before continuing, you can have a look at the answers to this question.
That being say, if you want Excel to be fully open before running any shell commands, you can use a MsgBox like you originally intended, but it has to be VBA's MsgBox that you would simply call like this:
MsgBox "Measurement will begin shortly"
The VBA thread will wait for the "OK" button to be pressed before continuing the execution.
Cleanly cancelling a long API-Ridden procedure is hellish, and I'm attempting to work out the best way to navigate the hellishness.
I'm using excel 2016 (with manual calculations and no screen updates) - I may take some time to attempt to run the procedure on 2010 to see if any issues resolve in the coming days (I'm aware of the slowdowns).
Over time, my procedure LongProcedure has lost its ability to successfully use its cancel feature (presumably due to increasing complexity). It was initially inconsistent and required significant spam-clicking to cancel, and now it fails altogether
Here's the setup:
First, LongProcedure is in a class module LongClass with a public property checked against for early cancelling, allowing it to clean up.
Public Sub LongProcedure()
' [Set up some things] '
For Each ' [Item In Some Large Collection (Est. 300 Items)] '
' [Some Code (ETA 5 Seconds) Sprinkled with 3-4 DoEvents] '
' [Export workbook (ETA 10 Seconds)] '
If (cancelLongProcedure) Then Exit For
Next
' [Clean up some things] '
GeneratorForm.Reset ' Let the UserForm know we're finished
End Sub
Second, I have a UserForm shown from a macro, which instantiates the procedure class, and runs the procedure. It contains a run button, a status label, and a cancel button.
Private MyLong As LongClass
Public Sub ButtonRunLongProcedure_Click()
Set myLong = New LongClass
myLong.LongProcedure()
End Sub
So the issue overall is twofold.
The ExportAsFixedFormat call opens a "Publishing..." progress bar which freezes excel for around ten seconds - fine. In all of my efforts, I haven't found a single way to process user input while this is happening.
On top of this, the DoEvents calls seemingly no longer do anything to allow the cancel button to be clicked. The process inconsistently freezes excel, tabs into other open programs, and (when not freezing) updates the status label.
I've Tried:
Appending DoEvents to the SetStatusLabel method instead of sprinkling - while the form still often freezes, it otherwise updates the status label consistently (while still not allowing the cancel button)
Using winAPI Sleep in place of, and in addition to DoEvents with delays of 1, 5, 10, 50, and 250ms - The form simply stopped updating at all without doevents, and with both it froze more.
Using a Do While loop to run DoEvents constantly for one second (Froze)
Overriding QueryClose to cancel the form. This one helped significantly. For some reason, the close [x] button can be clicked far more consistently than the userform buttons - Still not as consistently as I'd like. The problem? during publishing, Excel stops responding, and as such, modern windows will end the process if you click the close button twice... without cleanup.
Using Application.OnTime to regularly call DoEvents. Didn't seem to improve the situation overall
Alt-Tabbing. No, really. for some reason, while alt-tabbing occasionally just makes the UserForm freeze harder, sometimes it makes it stop freezing and update.
This is an issue I'm willing to do significant refactor work for, including smashing up the idea of the long procedure into separate methods, performing setup initially, and cleanup on class termination. I'm looking for something that provides consistent results. - I'll accept anything from excel versions to excel settings to refactors to winAPI calls.
Thanks for any insight into this one.
As it turns out simply combining together some of the useful improvements, along with a new one, made all the difference.
QueryClose is up to personal preference. Leave it in to catch more terminations, leave it out to ensure users use the new solution
Stick to sprinkling doEvents in places you feel are logical (not just when the status bar updates - like before and after an Application.Calculate call)
Optimize the long-running process as best you can, avoiding excel calls
And, most significantly
The integrated cancel key feature (CTRL+Break by default) is significantly more responsive than UserForm buttons and the form close button, without the chance of accidentally ending the excel task.
Here's the process to polish that for a finished product
First, set up a debugMode, or the inverse handleErrors, module-level variable to control whether to implement break-to-cancel and error handling. (Error handling will make your code harder to debug, so you'll appreciate the switch)
If your process is handling errors, you'll set Application.EnableCancelKey to xlErrorHandler, and On Error GoTo [ErrorHandlingLabel]. The error handling label should be directly before cleanup, and immediately set EnableCancelKey to xlDisabled to avoid bugs. Your handler should check the stored Err.Number and act accordingly, before continuing on to the cleanup steps.
Ensure that if you defer to any other complex vba in your script (such as using Application.Calculate on a sheet with UDFs), you set On Error GoTo 0 beforehand, and On Error GoTo [ErrorHandlingLabel] after, to avoid catching cellbound errors.
Unfortunately, the drawback is that for the UX to be consistently readable, you'll have to leave the cancel key on xlDisabled until the form is closed.
And in code:
Public Sub LongProcedure()
If handleErrors Then
On Error GoTo ErrorHandler
Application.EnableCancelKey = xlErrorHandler
End If
' [Set up some things] '
For Each ' [Item In Some Large Collection (Est. 300 Items)] '
' [Some Code (ETA 5 Seconds) Sprinkled with 3-4 DoEvents] '
' [Export workbook (ETA 10 Seconds)] '
Next
ErrorHandler:
If handleErrors Then
Application.EnableCancelKey = xlDisabled
If (Err.Number <> 0 And Err.Number <> 18) Then
MsgBox Err.Description, vbOKOnly, "Error " & CStr(Err.Number)
End If
Err.Clear
On Error GoTo 0
End If
' [Clean up some things] '
GeneratorForm.Reset ' Let the UserForm know we're finished
End Sub
and in the UserForm
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If MyLong.handleErrors Then Application.EnableCancelKey = xlInterrupt
End Sub
A small note that this method will likely generate a few bugs you weren't expecting to encounter because the execution jumps directly to the specified label. Your cleanup code will need to have required variables instantiated from the start.
Overall, once these issues are fixed, this setup ensures that the user can click CTRL+Break as many times as they could possibly want without causing crashes or popups.
Private Sub Workbook_Open()
Sheets("01").Delete
Sheets("02").Copy before:=Sheets("02")
Sheets("02 (2)").Name = "01"
Form1.Show
End Sub
Form1 appears shortly (something like flickering) and then - disappears forever
If I run this code outside Workbook_Open event - it works well.
When I place it back into Workbook_Open - again flickering - and disappearing.
When I remove the first three lines (run only Form1.Show) - it works.
Please, help.
--
sounds like it is just that you are seeing the code execute the requested processes.