i wondering how to disable the listbox scrollbar.Because i already have a scroll bar which can control both textbox scroll together at the same time. As i know,For Horizontal just add the width, how about vertical scroll bar without changing any height value?
This is inherent for listbox property,but anyway to change it? Thanks for help.
Image:
There is no inbuilt property that you can use to hide the scrollbars.
Usually the APIs work but in this case it is not working. The logic is to get the handle of the listbox and then hide the scrollbar. For example
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare 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 Function ShowScrollBar Lib "user32" (ByVal hWnd As Long, _
ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_HORZ = 0 '<~~ Horizontal Scrollbar
Private Const SB_VERT = 1 '<~~ Vertical Scrollbbar
Private Const SB_BOTH = 3 '<~~ Both ScrollBars
Dim lngMyHandle As Long, ChildRet As Long
Dim i As Long
Private Sub UserForm_Initialize()
For i = 1 To 100
ListBox1.AddItem i
ListBox2.AddItem i
Next i
End Sub
Private Sub CommandButton1_Click()
lngMyHandle = FindWindow("THUNDERDFRAME", Me.Caption)
If lngMyHandle <> 0 Then Debug.Print "Found Userform's handle"
ChildRet = FindWindowEx(lngMyHandle, ByVal 0&, "F3 Server 516c0000", vbNullString)
If ChildRet <> 0 Then Debug.Print "Found Listbox's Handle"
'~~> I Found the listbox Handle but it REFUSES TO WORK!!!
ShowScrollBar ChildRet, SB_BOTH, False
End Sub
I used spy++ to get the class of the listbox as shown below and in the code above I do get the value of ChildRet but I was disappointed. For the first time I am having a difficulty to understand as to why the API's are not working and I will continue experimenting with it.
ALTERNATIVE
Having said that there is an alternative. Place the Listbox in individual frames and reduce the width of the frame so that it hides the scrollbar. See this example
This is the most simplest way I could think of.
Related
I'm programming a small userform with multiple buttons, listboxes.
There is a button called "Delete" that i want to hide, because data should be deleted only in very rare cases.
The button should be only visible when i press certain keys on the keyboard. e.g. ctr + "e" oder ctr +"k".
When this keys are not pressed the button should be hidden again
I tried to use the event keydown of the userform but in vain.
can you help me please with this one ?
Thanks in advance
The easiest way to catch this would probably be to use the KeyPress and KeyUp events in the userform.
Something as simple as:
Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 11 Or KeyAscii = 5 Then Me.Delete.Visible = True
End Sub
Private Sub UserForm_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Me.Delete.Visible = False
End Sub
In the userform code.
And the KeyAscii set to whatever value you need, 11 being ctrl + k, 5 being ctrl + e.
Using KeyDown should work in a similar manner, but KeyCode and KeyAscii are different:
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 75 Then Me.Delete.Visible = True
End Sub
And then finally, for a toggle function:
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 75 And Not Me.Delete.Visible Then
Me.Delete.Visible = True
Else
Me.Delete.Visible = False
End If
End Sub
Using UserForm_ subs only triggers the code if the useform in question is in focus. If other userforms are in focus, then they would have to call the code, and if no useform is in focus, you can call a sub from a module with a shortcut from the macro menu. The same code, using the specific name rather than Me works for wherever you cal lthe code from.
When this keys are not pressed the button should be hidden again
This doesn't make sense to me. Because to use the button, one will have to let go of the CTRL key. I would recommend a second set of keys to hide it. Or better still... Use the same key!!! :)
Here is an example
Option Explicit
Private Declare PtrSafe Function RegisterHotKey Lib "user32" _
(ByVal hwnd As LongPtr, ByVal id As Long, _
ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare PtrSafe Function UnregisterHotKey Lib "user32" _
(ByVal hwnd As LongPtr, ByVal id As Long) As Long
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" _
Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, _
ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Private Const MOD_CONTROL = &H2
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private CancelTrap As Boolean
Private ShowHide As Boolean
Private Const ShowHideKey As Long = vbKeyE
Private Sub UserForm_Activate()
CaptureShowHideKey True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
CaptureShowHideKey False
End Sub
Private Sub CaptureShowHideKey(Trap As Boolean)
CancelTrap = Not Trap
If Trap = True Then
Call RegisterHotKey(0, &HBFFF&, MOD_CONTROL, ShowHideKey)
ShowHideButton
Else
Call UnregisterHotKey(0, &HBFFF&)
End If
End Sub
Private Sub ShowHideButton()
Dim message As MSG
Do While Not CancelTrap
WaitMessage
If PeekMessage(message, 0, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
If CommandButton1.Visible = False Then
CommandButton1.Visible = True
Else
CommandButton1.Visible = False
End If
End If
DoEvents
Loop
End Sub
IN ACTION
I've got a modeless userform in an Excel VBA project.
The userform is loaded by button on spreadsheet clicked (not an active-x button if that's relevant).
Because of modeless the user can work with excel or even other applications and than switch back to the form window. I need an event that fires if the form window becomes the active window again. I thought UserForm_Activate should do the job but it doesn't (neither does UserForm_GotFocus but there is no GotFocus event for userforms?). Is there any event that fires if the user switches back to a modeless userform (or in case not: is there any known work-around)? Or do I've got some strange bug here and Activate should fire?
Here's all the code I used for testing purpose:
' standard module:
Sub BUTTON_FormLoad()
' associated as macro triggered by button click on a sheet
UserForm1.Show vbModeless
End Sub
' UserForm1:
Private Sub UserForm_Activate()
' does not fire if focus comes back
Debug.Print "Activated"
End Sub
Private Sub UserForm_GotFocus()
' does not fire if focus comes back
' wrong code - no GotFocus event for userforms?
Debug.Print "Focussed"
End Sub
Private Sub UserForm_Click()
' only fires if clicked *inside* form
' does not fire eg if user clicks top of form window
Debug.Print "Clicked"
End Sub
Where do I find the documentation of userform events? It's not on the 'UserForm object' page.
The Activate event doesn't fire when you switch between the application and a modeless userform. This is by design.
Like I mentioned in the comments
You can achieve what you want by subclassing the userform and trapping the worksheet events but it very messy.
Here is a very basic example. Sample file can be downloaded from Here
READ ME FIRST:
This is just a basic sample. Please close all Excel Files before testing this.
If the user directly clicks a control on the userform and you want to run the activate code there as well then you will have to handle that as well.
Once you are happy, amend it to suit your need.
Place code in a Module
Option Explicit
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long)
Private Const GWL_WNDPROC = (-4)
Private WinProcOld As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Public formWasDeactivated As Boolean
'~~> Launch the form
Sub LaunchMyForm()
Dim frm As New UserForm1
frm.Show vbModeless
End Sub
'~~> Hooking the Title bar in case user clicks on the title bar
'~~> to activate the form
Public Function WinProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If wMsg = WM_NCLBUTTONDOWN Then
'~~> Ignoring unnecessary clicks to the title bar
'~~> by checking if the form was deactivated
If formWasDeactivated = True Then
formWasDeactivated = False
MsgBox "Form Activated"
End If
End If
WinProc = CallWindowProc(WinProcOld&, hwnd&, wMsg&, wParam&, lParam&)
End Function
'~~> Subclass the form
Sub SubClassUserform(hwnd As Long)
WinProcOld& = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WinProc)
End Sub
Sub UnSubClassUserform(hwnd As Long)
SetWindowLong hwnd, GWL_WNDPROC, WinProcOld&
WinProcOld& = 0
End Sub
Create a Userform. Let's call it Userform1. Add a command button in the form. Let's call it CommandButton1
Place code in Userform
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Dim hwnd As Long
Private Sub UserForm_Initialize()
hwnd = FindWindow(vbNullString, Me.Caption)
SubClassUserform hwnd
End Sub
'~~> Userform Click event
Private Sub UserForm_Click()
'~~> Ignoring unnecessary clicks
'~~> by checking if the form was deactivated
If formWasDeactivated = True Then
formWasDeactivated = False
MsgBox "Form Activated"
End If
End Sub
'~~> Unload the form
Private Sub CommandButton1_Click()
'~~> In case hwnd gets reset for whatever reason.
hwnd = FindWindow(vbNullString, Me.Caption)
UnSubClassUserform hwnd
Unload Me
End Sub
Place this code in the Workbook code area
Option Explicit
'~~> Checking if the form was deactivated
'~~> Add more events if you want
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
formWasDeactivated = True
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
formWasDeactivated = True
End Sub
Please feel free to add more workbook events. I have only used Workbook_SheetActivate and Workbook_SheetSelectionChange
And finally add a Form Button in the worksheet and assign the macro LaunchMyForm to it. And we are done
In Action
As far as I know, there isn't such an event within VBA. From the documentation:
The Activate and Deactivate events occur only when you move the focus
within an application. Moving the focus to or from an object in
another application doesn't trigger either event.
However, the Windows APIs can handle the event with a hook. The problem with Win APIs within VBA is that errors aren't handled by VBA so Excel will crash if/when the code encounters an error; so they can be frustrating for the developer. From a purely personal perspective, I like to keep code within the hook procedures to a minimum and pass any values to a class that can then fire events - this at least minimises the crashes. It's also important to remember to unhook before finishing your session.
Basic implementation of a Win API hook would look something like this:
In a class object (here it's called cHookHandler)
Option Explicit
Public Event HookWindowActivated()
Public Event HookIdChanged()
Private mHookId As LongPtr
Private mTargetWindows As Collection
Public Property Get HookID() As LongPtr
HookID = mHookId
End Property
Public Property Let HookID(RHS As LongPtr)
mHookId = RHS
RaiseEvent HookIdChanged
End Property
Public Sub AttachHook()
modHook.AttachHook Me
End Sub
Public Sub DetachHook()
modHook.DetachHook
End Sub
Public Sub AddTargetWindow(className As String, Optional windowTitle As String)
Dim v(1) As String
'Creates an array of [0 => className, 1=> windowTitle]
'which is stored in a collection and tested for in
'your hook callback.
v(0) = className
v(1) = windowTitle
mTargetWindows.Add v
End Sub
Public Sub TestForTargetWindowActivated(className As String, windowTitle As String)
Dim v As Variant
'Tests if the callback window is one that we're after.
For Each v In mTargetWindows
If v(0) = className Then
If v(1) = "" Or v(1) = windowTitle Then
'Fires the event that our target window has been activated.
RaiseEvent HookWindowActivated
Exit Sub
End If
End If
Next
End Sub
Private Sub Class_Initialize()
Set mTargetWindows = New Collection
End Sub
Private Sub Class_Terminate()
modHook.DetachHook
End Sub
Module code (here the module is called modHook)
Option Explicit
Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As LongPtr) As Long
Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As LongPtr, _
ByVal hmod As LongPtr, _
ByVal dwThreadId As Long) As LongPtr
Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
(ByVal hHook As LongPtr, _
ByVal ncode As Long, _
ByVal wParam As LongPtr, _
lParam As Any) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As LongPtr, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) 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 GetCurrentThreadId Lib "kernel32" () As Long
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private mHookHandler As cHookHandler
Public Sub AttachHook(hookHandler As cHookHandler)
Set mHookHandler = hookHandler
mHookHandler.HookID = SetWindowsHookEx(WH_CBT, AddressOf CBTCallback, 0, GetCurrentThreadId)
End Sub
Private Function CBTCallback(ByVal lMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As LongPtr
Dim className As String, windowTitle As String
If mHookHandler Is Nothing Then Exit Function
If lMsg = HCBT_ACTIVATE Then
className = GetClassText(wParam)
windowTitle = GetWindowTitle(wParam)
If Not mHookHandler Is Nothing Then
mHookHandler.TestForTargetWindowActivated className, windowTitle
End If
End If
CBTCallback = CallNextHookEx(mHookHandler.HookID, lMsg, ByVal wParam, ByVal lParam)
End Function
Public Sub DetachHook()
Dim ret As Long
If mHookHandler Is Nothing Then Exit Sub
ret = UnhookWindowsHookEx(mHookHandler.HookID)
If ret = 1 Then
mHookHandler.HookID = 0
End If
End Sub
Private Function GetWindowTitle(wParam As LongPtr) As String
Dim tWnd As String
Dim lWnd As Long
tWnd = String(100, Chr(0))
lWnd = GetWindowText(wParam, tWnd, 100)
tWnd = Left(tWnd, lWnd)
GetWindowTitle = tWnd
End Function
Private Function GetClassText(wParam As LongPtr) As String
Dim tWnd As String
Dim lWnd As Long
tWnd = String(100, Chr(0))
lWnd = GetClassName(wParam, tWnd, 100)
tWnd = Left(tWnd, lWnd)
GetClassText = tWnd
End Function
And in this example, all events are captured within the Userform
In this simple example, two buttons on the Userform attach and detach the hook, but you'd probably call the routines from somewhere else (perhaps the userform Initialize and Terminate events). The Userform also has a label lblHook displaying the HookId which I use during development - for production code, you probably wouldn't want this, so you could leave that bit out.
Option Explicit
Private WithEvents mHookHandler As cHookHandler
Private Sub btnHook_Click()
mHookHandler.AttachHook
End Sub
Private Sub btnUnhook_Click()
mHookHandler.DetachHook
End Sub
Private Sub mHookHandler_HookIdChanged()
lblHook.Caption = mHookHandler.HookID
End Sub
Private Sub mHookHandler_HookWindowActivated()
' Caveat: this routine will crash if halted in debugger.
Debug.Print "I've been activated!"
End Sub
Private Sub UserForm_Initialize()
Set mHookHandler = New cHookHandler
mHookHandler.AddTargetWindow "ThunderDFrame", Me.Caption
End Sub
Private Sub UserForm_Terminate()
Set mHookHandler = Nothing
End Sub
Try this. the event occurs after the form appears, so hide the wb inside an initialize event.
Private Sub UserForm_Initialize()
Set WB = ThisWorkbook Windows(WB.Name).Visible = False
The event does not exist and you can use Windows hooks to achieve your desired result. In my opinion, that's the direct answer and everything else is a workaround [unless it was posted by Siddharth Rout, in which case, THAT is the direct answer]
i want get a notification alerte in excel after 5 hour using VB or Macros ?
Calling WinAPI from VBA is risky but you may also try:
Option Explicit
Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal idEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal idEvent As Long) As Long
Public Sub AlertMe(dblMinutes As Double)
Dim idEvent As Long: idEvent = SetTimer(0&, 0&, CLng(dblMinutes * 60 * 1000), AddressOf AlertSub)
End Sub
Public Sub AlertSub(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
KillTimer 0&, idEvent
MsgBox "Alert!"
End Sub
You may save this one to e.g. Personal.xls and call it this way:
AlertMe 300 ' minutes
You can create reminders or notifications in MS Excel using 3 methods quickly and easily:
Use the IF function to display a message
=IF(B2<TODAY()+3,"Send Reminder","")
Use conditional formatting
Click on Home Tab
In the Styles command group select conditional formatting tab
Click on New Rule…
In the new formatting rule window select ‘Use a formula to determine which cells to format’
Under the ‘Format values where this formula is true:’ write the formula given below
=AND(C2<>"",C2<TODAY()+3)
Next click on Format and apply the formatting of the cell and font of your choice
Use Excel VBA with a for loop. The macro code is given below:
Private Sub Workbook_Open()
For Each cell In Range("B2:B100")
If cell.Value < Date + 3 And cell.Value <> “” Then
cell.Interior.ColorIndex = 3
cell.Font.ColorIndex = 2
cell.Font.Bold = True
End If
Next
End Sub
You can also initialize the formatting in the macro code above with the following line of code under Private Sub Workbook_Open():
Range("B2:B100").Interior.ColorIndex = xlNone
I can see the WindowActivate events firing, at various levels, when I switch between windows within excel, but is there a way to fire an event when excel becomes the foreground application? If I click out of excel and work, for example in the browser for a while and then click back onto an excel window, I don't see any events firing. Is there any way to detect this?
I would like to refresh some elements of my VBA application because, occasionally, I find that my Mouse Over feature, based on Hypertext Function, loses its ability to Activate charts. I can fix it by un-protecting and protecting the worksheet, or by trashing and re-initialising a subset of my objects. I would like trigger this action on the event that I am looking for.
I can also do this by SendKeys but it's not nice because it wipes out the keyboard settings (e.g. scroll lock) due to a documented bug in SendKeys and it makes the screen flicker more than I would like.
Since the code will reside in VBA I would limit the action to a particular workbook. If a different (passive) workbook is active when entering the Excel instance Window, then no action would be triggered and I can use the WorkbookActivate event to refresh the application if and when the user selects the workbook containing it.
I believe this is not provided in Excel directly, so use the Windows API. You can do win32 programming in VBA!
Explanation
You can use the win32 api function SetWinEventHook to get Windows to report certain events to you. Including EVENT_SYSTEM_FOREGROUND which is triggered when the foreground window changes. In the below example I check the new foreground window's process id against Excel's process id. This is a simple way to do it, but it will detect other Excel windows such as the VBA window the same as the main Excel window. This may or may not be the behavior you want and can be changed accordingly.
You have to be careful using SetWinEventHook, as that you pass a callback function to it. You are limited in what you can do in this callback function, it exists outside of VBA's normal execution and any errors inside it will cause Excel to crash in a messy unrecoverable way.
That's why I use Application.OnTime to report the events. They aren't gaurenteed to occur in order if multiple events are triggered more rapidly than Excel and VBA update. But it's safer. You could also update a collection or array of events, then read those back seperately outside of the WinEventFunc callback.
Example Code
To test this, create a new module and paste this code into it. Then run StartHook. Remember to run StopAllEventHooks before closing Excel or modifying the code!! In production code you'd probably add StartEventHook and StopAllEventHooks to the WorkBook_Open and WorkBook_BeforeClose events to ensure they get run at the appropriate times. Remember, if something happens to the WinEventFunc VBA code before the hook is stopped Excel will crash. This includes the code being modified or the workbook it is housed in being closed. Also do not press the stop button in VBA while a hook is active. The stop button can wipe the current program state!
Option Explicit
Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0
Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, _
ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, _
ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private pRunningHandles As Collection
Public Function StartEventHook() As Long
If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
pRunningHandles.Add StartEventHook
End Function
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
End Sub
Public Sub StartHook()
StartEventHook
End Sub
Public Sub StopAllEventHooks()
Dim vHook As Variant, lHook As Long
For Each vHook In pRunningHandles
lHook = vHook
StopEventHook lHook
Next vHook
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen.
On Error Resume Next
Dim thePID As Long
If LEvent = EVENT_SYSTEM_FOREGROUND Then
GetWindowThreadProcessId hWnd, thePID
If thePID = GetCurrentProcessId Then
Application.OnTime Now, "Event_GotFocus"
Else
Application.OnTime Now, "Event_LostFocus"
End If
End If
On Error GoTo 0
End Function
Public Sub Event_GotFocus()
Sheet1.[A1] = "Got Focus"
End Sub
Public Sub Event_LostFocus()
Sheet1.[A1] = "Nope"
End Sub
I modified #AndASM 's very nice solution to work in a 64 bit environment. Changes were
changed API function call parameters from Long to LongLong parameters
included PtrSafe attributes
replaced Sheet1.[A1] = with range("a1").value = syntax
#andasm's code with mods follows
Option Explicit
Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0
Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, _
ByVal eventMax As Long, _
ByVal hmodWinEventProc As LongLong, _
ByVal pfnWinEventProc As LongLong, _
ByVal idProcess As Long, _
ByVal idThread As Long, _
ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private pRunningHandles As Collection
Public Function StartEventHook() As Long
If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
pRunningHandles.Add StartEventHook
End Function
Public Sub StopEventHook(lHook As Long)
Dim LRet As Long
If lHook = 0 Then Exit Sub
LRet = UnhookWinEvent(lHook)
End Sub
Public Sub StartHook()
StartEventHook
End Sub
Public Sub StopAllEventHooks()
Dim vHook As Variant, lHook As Long
For Each vHook In pRunningHandles
lHook = vHook
StopEventHook lHook
Next vHook
End Sub
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
'This function is a callback passed to the win32 api
'We CANNOT throw an error or break. Bad things will happen.
On Error Resume Next
Dim thePID As Long
If LEvent = EVENT_SYSTEM_FOREGROUND Then
GetWindowThreadProcessId hWnd, thePID
If thePID = GetCurrentProcessId Then
Application.OnTime Now, "Event_GotFocus"
Else
Application.OnTime Now, "Event_LostFocus"
End If
End If
On Error GoTo 0
End Function
Public Sub Event_GotFocus()
Range("a1").Value = "Got Focus"
End Sub
Public Sub Event_LostFocus()
Range("a1").Value = "Nope"
End Sub
I have a user form that, when closed, needs to run cleanup steps. I would like for the X button to be disabled and/or not visible, but I still need to be able to unload the form. I've used code like the below, but it also blocks Unload Me.
'Disables closing via x button
Sub UserForm_QueryClose(Cancel As Integer, ClsoeMode As Integer)
If CloseMode = vbFormControlMenu Then
MsgBox ("BLOCKED")
Cancel = True
End If
End Sub
Do not use the UserForm_QueryClose in such a case. Use the API RemoveMenu, GetSystemMenu and FindWindow
This is my fav site for APIs
RemoveMenu : http://allapi.mentalis.org/apilist/RemoveMenu.shtml
GetSystemMenu : http://allapi.mentalis.org/apilist/GetSystemMenu.shtml
FindWindow : http://allapi.mentalis.org/apilist/FindWindow.shtml
See this example
Option Explicit
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const MF_BYPOSITION = &H400&
Private Sub UserForm_Initialize()
Dim Ret As Long
'~~> Change UserForm1 to match your userform's caption
Ret = FindWindow("ThunderDFrame", "UserForm1")
Do While Ret = 0
'~~> Change UserForm1 to match your userform's caption
Ret = FindWindow("ThunderDFrame", "UserForm1")
DoEvents
Loop
RemoveMenu GetSystemMenu(Ret, 0), 6, MF_BYPOSITION
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Screenshot:
Instead of giving the user a message saying he can't click the red x, trap it the way you did, and do the cleanup before unloading the form:
Sub UserForm_QueryClose(Cancel As Integer, ClsoeMode As Integer)
If CloseMode = vbFormControlMenu Then
' run cleanup code here
End If
End Sub
If the form has a close button that does the cleanup, then use something like this:
Sub UserForm_QueryClose(Cancel As Integer, ClsoeMode As Integer)
If CloseMode = vbFormControlMenu Then
' click event code for Close button:
btnClose_Click
Cancel = True
End If
End Sub
No need to go overboard with Windows APIs, since this is all built-in.
I know this is an old feed but you spelt ClsoeMode wrong. Simply change that to CloseMode and this should resolve your issue.