So I just convert my vba code to addoin (.xlam) for better way to update code for multiple workbooks.
I create function that runs every time when window is change (Application.OnWindow = function).
Each time this function runs it does multiple checks and set the workbook to public class modul -> Public WithEvents ... As Workbook.
This was working fine, but I run in to a problem, when user closes different workbook from windows bottom ribbon the excel doesnt run before_close event for that workbook.
So I create a collection, where I store workbooks - each time window is change function (Application.OnWindow = function) checks if workbook is in collection if not add the workbook WithEvent.
This again was working fine even when user closed the workbook from ribbon, but again I run into another problem. When user closed the workbook (and there was another workbook open) it would not remove the event from collection. So again I create delete mesure on workbook before_close.
And there is my final problem with before close prompt. This prompt runs after Before_Close event and I cant tell if I shoudl delete the event from collection or not.
I find temporerly fix from old post Before_Close Event Cleanup Limitation which works fine, but I woudl prefer to keep original prompt...
So I tried other option on same post from Jaafar Tribak Before_Close Event Cleanup Limitation It didnt work beacues of my version so I rewrite Declare functions for different versions, but it still doesnt work :
Workbook module:
Standard module:
So I am asking. How to make that code work or should I change my whole set with events approach and try somethink different ?
I create function that runs every time when window is change (Application.OnWindow = function).
Each time this function runs it does multiple checks and set the workbook to public class modul -> Public WithEvents ... As Workbook.
This was working fine, but I run in to a problem, when user closes different workbook from windows bottom ribbon the excel doesnt run before_close event for that workbook.
So I create a collection, where I store workbooks - each time window is change function (Application.OnWindow = function) checks if workbook is in collection if not add the workbook WithEvent.
This again was working fine even when user closed the workbook from ribbon, but again I run into another problem. When user closed the workbook (and there was another workbook open) it would not remove the event from collection. So again I create delete mesure on workbook before_close.
And there is my final problem with before close prompt. This prompt runs after Before_Close event and I cant tell if I shoudl delete the event from collection or not.
I find temporerly fix from old post Before_Close Event Cleanup Limitation which works fine, but I woudl prefer to keep original prompt...
So I tried other option on same post from Jaafar Tribak Before_Close Event Cleanup Limitation It didnt work beacues of my version so I rewrite Declare functions for different versions, but it still doesnt work :
Workbook module:
VBA Code:
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'CleanUp code goes here before the Monitor_Save_Changes
Monitor_Save_Changes = True
End Sub
'This Procedure MUST be Public
Public Sub MonitorProc(UserAction As Yes_No_Cancel)
Debug.Print "RUN"
Select Case UserAction
Case Is = Yes
MsgBox "You Saved changes."
Case Is = No
MsgBox "You Discarded changes."
Case Is = Cancel
MsgBox "You Canceled Closing"
'undo any before_close cleanup code here...
End Select
End SubStandard module:
VBA Code:
Option Explicit
Enum Yes_No_Cancel
Yes = 6
No = 7
Cancel = 2
End Enum
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongLong, ByVal nIndex As Long) As LongLong
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongLong, ByVal nIndex As Long, ByVal dwNewLong As LongLong) As LongLong
#Else
Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As Object, phwnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#End If
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
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 CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal MSG As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) 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 UnhookWindowsHookEx Lib "user32" (ByVal hhk As LongPtr) As Long
Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
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 SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
#Else
Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) 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 SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
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 CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hhk As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal uIDEvent As Long) As Long
#End If
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_CREATEWND = 3
Private Const GWL_WNDPROC = (-4)
Private Const WM_COMMAND = &H111
Private Const BN_CLICKED = 0
Private lCBTHook As Long
Private lPrevWnProc As Long
Public glLoword As Long
Private glHwnd As Long
Private glMsg As Long
Private glWparam As Long
Private glLparam As Long
'*******************
'Public Property.
'*******************
Public Property Let Monitor_Save_Changes(ByVal Status As Boolean)
'Set a CBT hook to catch the 'Save Changes' Wnd creation.
If Not ActiveWorkbook.Saved And Status Then
lCBTHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, _
GetAppInstance, GetCurrentThreadId)
End If
End Property
'*******************
'Private Routines.
'*******************
Private Function CBTProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim sBuffer As String
Dim lRetVal As Long
Select Case idHook
Case Is = HCBT_CREATEWND
'Some Wnd has been created within the excel process.
sBuffer = Space(256)
lRetVal = GetClassName(wParam, sBuffer, 256)
'Is it our 'SaveChanges' wnd ?
If Left(sBuffer, lRetVal) = "#32770" Then 'Or Left(sBuffer, lRetVal) = "NUIDialog" Then
'if so subclass it now.
lPrevWnProc = SetWindowLong _
(wParam, GWL_WNDPROC, AddressOf CallBack)
End If
'done with hook.
UnhookWindowsHookEx lCBTHook
End Select
'Call next hook if any.
CBTProc = CallNextHookEx _
(lCBTHook, idHook, ByVal wParam, ByVal lParam)
End Function
Private Function CallBack _
(ByVal hWnd As Long, ByVal MSG As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Dim LowWord As Long, HighWord As Long
Debug.Print "CallBack"
'Process the notifications sent by the buttons in the 'Save changes' Wnd.
Select Case MSG
Case WM_COMMAND
Debug.Print "WM_COMMAND"
GetHiLoword wParam, LowWord, HighWord
Call SetWindowLong(hWnd, GWL_WNDPROC, lPrevWnProc)
'store the arg values for later use in the TimerProc
glHwnd = hWnd
glMsg = MSG
glWparam = wParam
glLparam = lParam
glLoword = LowWord
'run the timer
SetTimer Application.hWnd, 0, 1, AddressOf TimerProc
If LowWord = Yes_No_Cancel.Yes Or LowWord = Yes_No_Cancel.No Then
Exit Function
End If
End Select
CallBack = CallWindowProc _
(lPrevWnProc, hWnd, MSG, wParam, ByVal lParam)
End Function
Private Sub TimerProc()
On Error Resume Next
Debug.Print "TimerProc"
KillTimer Application.hWnd, 0
Call ActiveWorkbook.MonitorProc(glLoword)
Call CallWindowProc _
(lPrevWnProc, glHwnd, glMsg, glWparam, ByVal glLparam)
End Sub
Private Sub GetHiLoword _
(wParam As Long, ByRef loword As Long, ByRef hiword As Long)
' this is the LOWORD of the wParam:
loword = wParam And &HFFFF&
' LOWORD now equals 65,535 or &HFFFF
' this is the HIWORD of the wParam:
hiword = wParam \ &H10000 And &HFFFF&
' HIWORD now equals 30,583 or &H7777
End Sub
Private Function GetAppInstance() As Long
GetAppInstance = GetWindowLong _
(FindWindow("XLMAIN", Application.Caption), GWL_HINSTANCE)
End FunctionSo I am asking. How to make that code work or should I change my whole set with events approach and try somethink different ?
