There is no documentation of "windows" key :https://learn.microsoft.com/en-us/office/vba/api/excel.application.sendkeys
I wanted a combination of "Windows+UP" key to Maximize Active window.
So, I tried "Ctrl+Esc" for windows key + {UP} : Application.SendKeys ("^({ESC}{UP})") but it didn't work.
Is there a way to send windows key using API, dll etc without using external programs like AutoIt.
Is there a way to send windows key using API, dll etc without using external programs like AutoIt
Yes, you can use FindWindow and ShowWindow API to maximize a window. This is more reliable than using Sendkeys.
Here is an example
Option Explicit
Private Declare PtrSafe Function ShowWindow Lib "user32" _
(ByVal hwnd As LongPtr, ByVal nCmdSHow As Long) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Const SW_SHOWMAXIMIZED = 3
Sub MaximizeAWindow()
Dim hwnd As Long
Dim Caption As String
Caption = "THIS IS THE CAPTION OF THE WINDOW"
hwnd = FindWindow(vbNullString, Caption)
If hwnd <> 0 Then
ShowWindow hwnd, SW_SHOWMAXIMIZED
Else
MsgBox "Unable to find the window. Is the caption correct?"
End If
End Sub
You may be also interested in GetForegroundWindow and the GetWindowText API to get the caption of the current active window?
Related
Here we go again at the old question of pressing "OK" that has been very frustrating to solve.
I recorded a Script in SAP to print a document but somehow when it opens an new printer dialog box I have to click manually "Ok" and the script is not showing me what window or button it is.
Here is the Script and the dialog window:
Sub SAP_PrntLgBestListe_Conv()
If Not IsObject(SAPapplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPapplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(SAPconnection) Then
Set SAPconnection = SAPapplication.Children(0)
End If
If Not IsObject(SAPSession) Then
Set SAPSession = SAPconnection.Children(0)
End If
If IsObject(wscript) Then
wscript.ConnectObject SAPSession, "on"
wscript.ConnectObject Application, "on"
End If
With SAPSession
.StartTransaction "MB52"
.findById("wnd[0]/tbar[1]/btn[17]").press
.findById("wnd[1]/usr/txtENAME-LOW").Text = "DARASIC"
.findById("wnd[1]/tbar[0]/btn[8]").press
.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").currentCellRow = 1
.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").selectedRows = "1"
.findById("wnd[1]/usr/cntlALV_CONTAINER_1/shellcont/shell").doubleClickCurrentCell
.findById("wnd[0]/tbar[1]/btn[8]").press
.findById("wnd[0]/tbar[0]/btn[86]").press
.findById("wnd[1]/tbar[0]/btn[13]").press 'Spool-Order sent to SAP-Printer LOCL - Printer window appears
' Here needs to click OK on printer window
End With
End Sub
You need to use some programs to check the object's location (go with API). I'm using Window Detective. An example of your code should be something like this:
Private Declare PtrSafe Function findWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function findWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare PtrSafe Function sendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Function print_window()
Dim saveWindowPrint As Long
check_agn_open_window:
'--- find Print Window
saveWindowPrint = findWindow(vbNullString, "Drucken")
'--- check if saveWindow is open
If saveWindowPrint = 0 Then: GoTo check_agn_open_window
'--- Get Save button
buttonOK = findWindowEx(saveWindowPrint, 0, "Button", "OK")
'--- click on the save button
sendMessage buttonOK, &HF5&, 0, 0
End Function
And after that, you need to go to with saving window. So, use also API for this.
I have a process that requires an active VPN connection, but the connection is automatically cut every 8 hours. I need to be able to control that the connection is active and the time left up to the 8 hour limit.
In the properties of the windows connections the time appears (attached capture with the data that I need), but I need to know how to read this data.
Try the next approach, please:
Edited, because of the last request:
Please add two new declarations
Copy the next API functions on top of a standard module:
Option Explicit
Private Declare PtrSafe Function FindWindow Lib "User32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "User32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As LongPtr, _
ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, _
ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "User32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
And the next Constant:
Private Const GW_HWNDNEXT = 2
'Added after editing:__________________
Private Const WM_LBUTTON_DOWN = &H201
Private Const BM_CLICK = &HF5
'______________________________________
In the same standard module, copy the next Sub. Please, take care to change Duration: from the code, with the Spanish correct variant ('Duración' [with the necessary accent]):
Sub DurationAPI()
Dim hwndEth As LongPtr, hwndGen As LongPtr, hwndDurlbl As LongPtr, hwndDur As LongPtr
Dim sStr As String, strWindowTitle As String, durationLbl As String, durT As Date, limitD As Date
'added after editing:_____________________________
OpenWiFiConnectionWindow 'open connection window
AppActivate Application.ActiveWindow.Caption
'_________________________________________________
limitD = CDate("08:00:00")
strWindowTitle = "Estado de Wi-Fi"
durationLbl = "Duration:" 'Please change here with your exact label title (in Spanish...)
'I cannot write duracion: with the necessary accent...
hwndEth = FindWindow(vbNullString, strWindowTitle): Debug.Print Hex(hwndEth)
hwndGen = FindWindowEx(hwndEth, 0&, vbNullString, "General"): Debug.Print Hex(hwndGen)
hwndDurlbl = FindWindowEx(hwndGen, 0&, vbNullString, durationLbl): Debug.Print Hex(hwndDurlbl)
hwndDur = GetWindow(hwndDurlbl, GW_HWNDNEXT): Debug.Print Hex(hwndDur)
sStr = String(GetWindowTextLength(hwndDur) + 1, Chr$(0))
GetWindowText hwndDur, sStr, Len(sStr)
durT = CDate(sStr)
MsgBox Format(limitD - durT, "hh:mm:ss") & " left until connection will be interrupted!", _
vbInformation, "Time to connection interruption"
'Added after editing: ____________________________________________________
Dim hwndClose As LongPtr
'closing the connection window:
hwndClose = FindWindowEx(hwndEth, 0&, vbNullString, "&Close"): Debug.Print Hex(hwndClose)
SendMessage hwndClose, WM_LBUTTON_DOWN, 0&, 0&
SendMessage hwndClose, BM_CLICK, 0, ByVal 0&
'_________________________________________________________________________
End Sub
bis Copy the Sub able to show the necessary connection window:
Private Sub OpenWiFiConnectionWindow()
Dim objApp As Object: Set objApp = CreateObject("Shell.Application")
Dim objFolder As Object: Set objFolder = objApp.Namespace(&H31&).self.GetFolder
Dim interface As Variant, interfaceTarget As Object, InterfaceName As String
InterfaceName = "Wi-Fi" 'Please, check here what is show your "Network Connections" folder. It maybe can be slightly different...
'I tested the code on my Ethernet connection, which not was simple "Ethernet". It was "Ethernet 2"...
For Each interface In objFolder.Items
If LCase(interface.Name) = LCase(InterfaceName) Then
Set interfaceTarget = interface: Exit For
End If
Next
Dim Verb As Variant
For Each Verb In interfaceTarget.Verbs
If Verb.Name = "Stat&us" Then
Verb.DoIt
Application.Wait Now + TimeValue("0:00:01")
Exit For
End If
Next
End Sub
Please, try this Sub first, in order to be sure that it shows the necessary connection window. If it doesn't, please look in the "Network Connections" folder and change InterfaceName with an appropriate one.
Run the above DurationAPI() Sub.
All the necessary windows handlers are returned in Immediate window. If one of them is 0 (zero), there must be checked to understand what is happening... I used Spy++ to find the windows titles/classes...
For a window with English titles, it returns correctly and almost instant the necessary connection duration time.
I have a macro that does some actions using the UI Automation framework. I would like to suppress the rapid movements on the ribbon during the macro execution and would like to simply show the outcome at end. I tried using Application.ScreenUpdating, but it looks like it is a setting that does not apply to the ribbon.
Is there any setting out there that can be used to manipulate the screen updates for the Excel ribbon?
EDIT: the Automation framework can be referenced as UIAutomationClient in the VBA project. The dll file is UIAutomationCore.dll
Thanks
Summary
LockWindowUpdate: An Unreliable Solution
WM_SETREDRAW: A (too?) Powerful Solution
SW_SHOWMINIMIZED: A Subtle Solution
1) LockWindowUpdate: An Unreliable Solution
It seems like there is a Windows API function that some people suggest: LockWindowUpdate. The main problem is that it seems unreliable based on the tests that I've done and the 2 posts that I've found:
Windows API SendMessage to freeze screen in Excel VBA (Doesn't work on all machines)
API LockWindowUpdate don't work as expected - You can read in that second post the following:
LockWindowUpdate is not intended for general-purpose suppression of window redraw. The purpose of the LockWindowUpdate function is to permit drag/drop feedback to be drawn over a window without interference from the window itself. The intent is that the window is locked when feedback is drawn and unlocked when feedback is complete.
But if you want to test it for yourself, it can be declared at the top of your module with the following backward compatible declaration construct:
'LockWindowUpdate declaration
#If VBA7 Then
Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As LongPtr) As Long
#Else
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long
#End If
So, by supplying the window handle of the workbook you are interacting with (must be the top window), you may be able to temporarily freeze that Window. For example you could add:
'WindowHandle declaration
#If VBA7 Then
Private WindowHandle As LongPtr
#Else
Private WindowHandle As Long
#End If
'GetForegroundWindow declaration
#If VBA7 Then
Private Declare PtrSafe Function GetForegroundWindow Lib "USER32" () As LongPtr
#Else
Private Declare Function GetForegroundWindow Lib "user32" () As Long
#End If
Sub LockWindow()
On Error GoTo ErrHandler
WindowHandle = GetForegroundWindow
LockWindowUpdate WindowHandle
'Your code here
ErrHandler:
LockWindowUpdate WindowHandle
End Sub
2) WM_SETREDRAW: A Powerful Solution
There is also a message that you can send via the SendMessage Window API function that is exaclty made for preventing a window to be redrawn or refreshed.
To implement this for an Excel workbook, you could use the following declaration of the SendMessage function, the GetForegroundWindow (see code from above) and the appropriate constant:
'SendMessage declaration
#If VBA7 Then
Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If
'SendMessage Message(s)
Private Const WM_SETREDRAW = &HB
You would then surround your code like in the following example:
Sub FreezeWorkbook()
On Error GoTo ErrHandler
WindowHandle = GetForegroundWindow
Call SendMessage(WindowHandle, WM_SETREDRAW, False, 0&)
'Your code here
ErrHandler:
Call SendMessage(WindowHandle, WM_SETREDRAW, True, 0&)
End Sub
I haven't been able to test it with UI Automation commands, but it seems like it should work.
A more drastic alternative
If that doesn't work, you might want to consider doing it for the screen as a whole. For that you'll need a special function that returns the handle for the desktop:
'GetDesktopWindow declaration
#If VBA7 Then
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
#Else
Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If
And the rest is basically the same:
Sub FreezeDesktop()
On Error GoTo ErrHandler
Call SendMessage(GetDesktopWindow, WM_SETREDRAW, False, 0&)
'Your code here
ErrHandler:
Call SendMessage(GetDesktopWindow, WM_SETREDRAW, True, 0&)
End Sub
Note that the use of error handling is even more crucial here because you don't want your whole screen to remain frozen in case of an unhandled error.
[However, if it were to happen, you could still] press the keyboard sleep key and then after entering the sleep state,
press the WakeUp key .. that shoud unfreeze the computer and avoid any
accidental loss of data. (source)
3) SW_SHOWMINIMIZED: A Subtle Solution
If the previous solution is interfering with your UI Automation process, you might want to consider a more subtle solution that solves your problem indirectly. I'm talking about minimizing the window at the beginning of your code and maximizing it at the end.
This is not exactly what you wanted, but at least the user won't see the window while the interaction occurs. Based on the tests that I've done, the fact that a window is minimized shouldn't affect UI Automation commands.
'WindowHandle declaration
#If VBA7 Then
Private WindowHandle As LongPtr
#Else
Private WindowHandle As Long
#End If
'GetForegroundWindow declaration
#If VBA7 Then
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
#Else
Private Declare Function GetForegroundWindow Lib "user32" () As Long
#End If
'ShowWindow declaration
#If VBA7 Then
Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
#Else
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
'ShowWindow Commands
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
Sub MinimizeAndMaximize()
On Error GoTo ErrHandler
WindowHandle = GetForegroundWindow
ShowWindow WindowHandle, SW_SHOWMINIMIZED
'Your code here
ErrHandler:
ShowWindow WindowHandle, SW_MAXIMIZE
End Sub
Please Look at the code below and test it:
Private Sub CommandButton1_Click()
MsgBox "This window converted Right to Left!", vbMsgBoxRtlReading
End Sub
This code convert the message window from right to left. As the close button moves to the left of the window. How do I do this for userforms?
(Hope T.M., Mathieu Guindon and ... does not say: "Your question is amiss. Please read the links ....")
Like the picture below (Of course photo is photoshop!):
Simulate Right To Left display as in MsgBox
It'll be necessary to use some API *) functions to get the wanted layout independant from language settings using right to left functionality by default.
Identify the Userform's handle to get access to further API methods
Remove the Userform's title bar
Replace it e.g. with a Label control displaying the caption and give it drag functionality to move the UserForm (here: Label1).
Use another control (here: Label2) to simulate the system escape "x".
*) API - Application Programming Interface
A simple UserForm code example
All you need is to provide for 2 Label controls where Label1 replaces the title bar and receives the UserForm's caption and Label2 simulates the system Escape "x". Furthermore this example uses a Type declaration for easy disposal of the UserForm handle for several event procedures needing it for further API actions.
► Note to 2nd edit as of 10/22 2018
As a window handle is declared as LongPtr in Office 2010 or higher and as Long in versions before, it was necessary to differentiate between the different versions by conditional compile constants (e.g. #If VBA7 Then ... #Else ... #End If; cf. section II. using also the Win64 constant to identify actually installed 64bit Office systems - note that frequently Office is installed as 32bit by default).
Option Explicit ' declaration head of userform code module
#If VBA7 Then ' compile constant for Office 2010 and higher
Private Type TThis ' Type declaratation
frmHandle As LongPtr ' receives form window handle 64bit to identify this userform
End Type
#Else ' older versions
Private Type TThis ' Type declaratation
frmHandle As Long ' receives form window handle 32bit to identify this userform
End Type
#End If
Dim this As TThis ' this - used by all procedures within this module
Private Sub UserForm_Initialize()
' ~~~~~~~~~~~~~~~~~~~~~~~
' [1] get Form Handle
' ~~~~~~~~~~~~~~~~~~~~~~~
this.frmHandle = Identify(Me) ' get UserForm handle via API call (Long)
' ~~~~~~~~~~~~~~~~~~~~~~~
' [2] remove System Title Bar
' ~~~~~~~~~~~~~~~~~~~~~~~
HideTitleBar (this.frmHandle) ' hide title bar via API call
End Sub
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Purpose: Replaces System Title Bar (after removal via API) and receives dragging functionality
' ~~~~~~~~~~~~~~~~~~~~~~~~~~
' [3] allow to move UserForm
' ~~~~~~~~~~~~~~~~~~~~~~~~~~
If Button = 1 Then DragForm this.frmHandle
End Sub
Private Sub Label2_Click()
' Purpose: Label "x" replaces System Escape (after removal in step [2])and hides UserForm
' ~~~~~~~~~~~~~~~~~
' [4] hide UserForm
' ~~~~~~~~~~~~~~~~~
Me.Hide
End Sub
Private Sub UserForm_Layout()
Me.RightToLeft = True
' Simulated Escape Icon
Me.Label2.Caption = " x"
Me.Label2.BackColor = vbWhite
Me.Label2.Top = 0
Me.Label2.Left = 0
Me.Label2.Width = 18: Me.Label2.Height = 18
' Simulated UserForm Caption
Me.Label1.Caption = Me.Caption
Me.Label1.TextAlign = fmTextAlignRight ' <~~ assign right to left property
Me.Label1.BackColor = vbWhite
Me.Label1.Top = 0: Me.Label1.Left = Me.Label2.Width: Me.Label1.Height = Me.Label2.Height
Me.Label1.Width = Me.Width - Me.Label2.Width - 4
End Sub
II. Separate code module for API functions
a) Declaration head with constants and special API declarations
It's necessary to provide for different application versions as the code declarations differ in some arguments (e.g. PtrSafe). 64 bit declarations start as follows: Private Declare PtrSafe ...
Take also care of the correct declarations via #If, #Else and #End If allowing version dependant compilation.
The prefix &H used in constants stands for hexadecimal values.
Option Explicit
Private Const WM_NCLBUTTONDOWN = &HA1&
Private Const HTCAPTION = 2&
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_CAPTION = WS_BORDER Or WS_DLGFRAME
#If VBA7 Then ' True if you're using Office 2010 or higher
' [0] ReleaseCapture
Private Declare PtrSafe Sub ReleaseCapture Lib "User32" ()
' [1] SendMessage
Private Declare PtrSafe Function SendMessage Lib "User32" _
Alias "SendMessageA" _
(ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr ' << arg's hWnd, wParam + function type: LongPtr
' [2] FindWindow
Private Declare PtrSafe Function FindWindow Lib "User32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr ' << function type: LongPtr
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Two API functions requiring the Win64 compile constant for 64bit Office installations
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#If Win64 Then ' true if Office explicitly installed as 64bit
' [3a] Note that GetWindowLong has been replaced by GetWindowLongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" _
Alias "GetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
' [3b] Note that GetWindowLong has been replaced by GetWindowLongPtr
' Changes an attribute of the specified window.
' The function also sets a value at the specified offset in the extra window memory.
Private Declare PtrSafe Function SetWindowLongPtr Lib "User32" _
Alias "SetWindowLongPtrA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#Else ' true if Office install defaults 32bit
' [3aa] Note that GetWindowLong has been replaced by GetWindowLongPtr Alias GetWindowLongA !
Private Declare PtrSafe Function GetWindowLongPtr Lib "User32" _
Alias "GetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long) As LongPtr
' [3bb] Note that GetWindowLong has been replaced by GetWindowLongPtr Alias SetWindowLongA !
Private Declare PtrSafe Function SetWindowLongPtr Lib "User32" _
Alias "SetWindowLongA" _
(ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr) As LongPtr
#End If
' [4] DrawMenuBar
Private Declare PtrSafe Function DrawMenuBar Lib "User32" _
(ByVal hWnd As LongPtr) As Long ' << arg hWnd: LongPtr
#Else ' True if you're using Office before 2010 ('97)
Private Declare Sub ReleaseCapture Lib "User32" ()
Private Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "User32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "User32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" _
(ByVal hWnd As Long) As Long
#End If
b) Following Procedures (after section a)
' ~~~~~~~~~~~~~~~~~~~~~~
' 3 Procedures using API
' ~~~~~~~~~~~~~~~~~~~~~~
#If VBA7 Then ' Office 2010 and higher
Public Function Identify(frm As Object) As LongPtr
' Purpose: [1] return window handle of form
' Note: vbNullString instead of ThunderXFrame (97) and class names of later versions
Identify = FindWindow(vbNullString, frm.Caption)
End Function
Public Sub HideTitleBar(hWnd As LongPtr)
' Purpose: [2] remove Userform title bar
SetWindowLongPtr hWnd, GWL_STYLE, GetWindowLongPtr(hWnd, GWL_STYLE) And Not WS_CAPTION
End Sub
Public Sub ShowTitleBar(hWnd As LongPtr)
' Purpose: show Userform title bar
SetWindowLongPtr hWnd, GWL_STYLE, GetWindowLongPtr(hWnd, GWL_STYLE) Or WS_CAPTION
End Sub
Public Sub DragForm(hWnd As LongPtr)
' Purpose: [3] allow to drag & move userform via control (here via e.g.: Label1)
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
#Else ' vers. before Office 2010 (Office '97)
Public Function Identify(frm As Object) As Long
' Purpose: [1] return window handle of form
' Note: vbNullString instead of ThunderXFrame (97) and class names of later versions
Identify = FindWindow(vbNullString, frm.Caption)
End Function
Public Sub HideTitleBar(hWnd As Long)
' Purpose: [2] remove Userform title bar
SetWindowLong hWnd, GWL_STYLE, GetWindowLong(hWnd, GWL_STYLE) And Not WS_CAPTION
End Sub
' Public Sub ShowTitleBar(HWND As Long)
' ' Purpose: show Userform title bar
' SetWindowLong HWND, GWL_STYLE, GetWindowLong(HWND, GWL_STYLE) Or WS_CAPTION
' End Sub
Public Sub DragForm(hWnd As Long)
' Purpose: [3] allow to drag & move userform via control (here via e.g.: Label1)
Call ReleaseCapture
Call SendMessage(hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
#End If
► Caveat: API declarations not tested for actually installed 64 bit systems in Office 2010 or higher. The 2nd Edit as of 10/22 2018 tries to correct several LongPtr declarations (only for pointers to a → handle or → memory location) and using the current Get/SetWindowLongPtr function differentiating explicitly between Win64 and Win32; cf. also edited Type declaration in the UserForm code module's declaration head).
See also Compatibility between 32bit and 64bit Versions of Office 2010 and Office 2010 Help Files: Win32API PtrSafe with 64bit Support
Additional note
UserForms are Windows and can be identified by their window handle.
The API function used for this purpose is FindWindow disposing of two arguments:
1) A string giving the name of the class of the window it needs to find and 2) a string giving the caption of the window (UserForm) it needs to find.
Therefore frequently one distinguishes between version '97 (UserForm class name "ThunderXFrame") and later versions ("ThunderDFrame"):
If Val(Application.Version) < 9 Then
hWnd = FindWindow("ThunderXFrame", frm.Caption) ' if used within Form: Me.Caption
Else ' later versions
hWnd = FindWindow("ThunderDFrame", frm.Caption) ' if used within Form: Me.Caption
End If
However using vbNullString (and unique captions!) instead makes coding much easier:
hWnd = FindWindow(vbNullString, frm.Caption) ' if used within Form: Me.Caption
Recommended further reading
UserForm code modules actually are classes and should be used as such. So I recommend reading M. Guindon's article UserForm1.Show. - Possibly of some interest, as well is Destroy a modeless UserForm instance properly
I have an Excel VBA UDF that performs some expensive calculations. Currently, Excel tries to run the function when the user clicks on the Insert Function dialog (the 'fx' button next to the formula bar), and this causes problems in my code.
Is there a way I can set the function to not calculate when the user has the Insert Function dialog (or the Function Arguments dialog, which is what shows up when the function name is already provided) open? I'd like to have the function only run when the user enters the formula in a cell or refreshes the sheet.
try adding this code to the start of your function:
If (Not Application.CommandBars("Standard").Controls(1).Enabled) Then Exit Function
It will quit your UDF if the function wizard is being used
There is one circumstance in which the "CommandBars" solution provided by Charles Williams fails, falsely indicating that the function wizard is active when it's not.
It happens when you open a comma-separated text file in Excel in which case all open Excel workbooks are recalculated, even if Excel calculation is set to manual. That's quite disruptive if you have workbooks open with slow-to-calculate VBA UDFs that use the CommandBars test to exit early if the Wizard is thought to be active.
Charles further suggests that the Windows API can be used as an alternative approach. I've not been able to find such code elsewhere so here's my attempt to implement Charles' suggestion.
Tested only on English-language 64-bit Excel 365.
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As LongPtr, ByRef lpdwProcessId As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Const GW_HWNDNEXT = 2
Function FunctionWizardActive() As Boolean
Dim ExcelPID As Long
Dim lhWndP As LongPtr
Dim WindowTitle As String
Dim WindowPID As Long
Const FunctionWizardCaption = "Function Arguments" 'This won't work for non English-language Excel
If TypeName(Application.Caller) = "Range" Then
'The "CommandBars test" below is usually sufficient to determine that the Function Wizard is active,
'but can sometimes give a false positive. Example: When a csv file is opened (via File Open) then all
'active workbooks are calculated (even if calculation is set to manual!) with
'Application.CommandBars("Standard").Controls(1).Enabled being False
'So apply a further test using Windows API to loop over all windows checking for a window with title "Function Arguments", checking also the process id.
If Not Application.CommandBars("Standard").Controls(1).Enabled Then
ExcelPID = GetCurrentProcessId()
lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
Do While lhWndP <> 0
WindowTitle = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
GetWindowText lhWndP, WindowTitle, Len(WindowTitle)
WindowTitle = Left$(WindowTitle, Len(WindowTitle) - 1)
If WindowTitle = FunctionWizardCaption Then
GetWindowThreadProcessId lhWndP, WindowPID
If WindowPID = ExcelPID Then
FunctionWizardActive = True
Exit Function
End If
End If
lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
Loop
End If
End If
End Function
With that function available, you can amend your slow VBA UDFs with the code:
If FunctionWizardActive() Then Exit Function