Пользовательский код окна сообщения не работает без предупреждения в последней версии Excel на Windows 10 64 бит

Question

Итак, я уже несколько лет пользуюсь этим классом кнопок Custom Message Box Buttons. Когда код был запущен сегодня, он просто разбил Excel без предупреждения или сообщения. Этот код полностью работал при запуске Windows 7, и наша компания решила перевести всех на windows 10 без предупреждения сегодня ... Первоначальный разработчик сказал на сайте, что он обновил его для 64-битной версии, так что я предполагаю, что это что-то делать с windows 10.

Исходный веб-сайт не работает, но вы по-прежнему можете получить доступ к содержимому и коду, используя обратную машину http://web.archive.org/web/20190304185310/http: //shutupdean.com/blog/2014/ 08/01 / vba-msgbox-custom-button-text /

Образец рабочей книги также можно загрузить для удобства. Я также добавил ссылку на нее http://web.archive.org/web/20190317215921if_/http: / /shutupdean.com:80/blog/wp-content/uploads/2014/08/CustomMsgbox.xlsm

Код модуля: modMsgbox

Option Explicit

Private Const HCBT_ACTIVATE = 5

Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal lpString As String) As LongPtr
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
#End If

Private m_hWnd As Long

Public Property Get hWndApplication() As Long
    If m_hWnd = 0 Then
        If Application.Name = "Microsoft Access" Then
             m_hWnd = FindWindow("OMain", vbNullString)
        ElseIf Application.Name = "Microsoft Word" Then
            m_hWnd = FindWindow("OpusApp", vbNullString)
        ElseIf Application.Name = "Microsoft Excel" Then
            m_hWnd = FindWindow("XLMAIN", vbNullString)
        End If
    End If
    hWndApplication = m_hWnd
End Property


Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long

    #If Win64 Then
        Dim lPtr As LongPtr
        Dim lProcHook As LongPtr
    #Else
        Dim lPtr As Long
        Dim lProcHook As Long
    #End If

    Dim cM As clsMsgbox

    Select Case uMsg
        Case HCBT_ACTIVATE
            lPtr = GetProp(hWndApplication, "ObjPtr")
            If (lPtr <> 0) Then
                Set cM = ObjectFromPtr(lPtr)
                If Not cM Is Nothing Then
                    If Len(cM.ButtonText1) > 0 And Len(cM.ButtonText2) > 0 And Len(cM.ButtonText3) > 0 Then
                        If cM.UseCancel Then
                            SetDlgItemText wParam, IDYES, cM.ButtonText1
                            SetDlgItemText wParam, IDNO, cM.ButtonText2
                            SetDlgItemText wParam, IDCANCEL, cM.ButtonText3
                        Else
                            SetDlgItemText wParam, IDABORT, cM.ButtonText1
                            SetDlgItemText wParam, IDRETRY, cM.ButtonText2
                            SetDlgItemText wParam, IDIGNORE, cM.ButtonText3
                        End If

                    ElseIf Len(cM.ButtonText1) > 0 And Len(cM.ButtonText2) Then
                        If cM.UseCancel Then
                            SetDlgItemText wParam, IDOK, cM.ButtonText1
                            SetDlgItemText wParam, IDCANCEL, cM.ButtonText2
                        Else
                            SetDlgItemText wParam, IDYES, cM.ButtonText1
                            SetDlgItemText wParam, IDNO, cM.ButtonText2
                        End If
                    Else
                        SetDlgItemText wParam, IDOK, cM.ButtonText1
                    End If
                    lProcHook = cM.ProcHook
                End If
            End If
            RemovePropPointer
            If lProcHook <> 0 Then UnhookWindowsHookEx lProcHook
    End Select

    MsgBoxHookProc = False
End Function
#If Win64 Then
    Private Property Get ObjectFromPtr(ByVal lPtr As LongPtr) As Object
        Dim obj As Object

        CopyMemory obj, lPtr, 4
        Set ObjectFromPtr = obj
        CopyMemory obj, 0&, 4
    End Property
#Else
    Private Property Get ObjectFromPtr(ByVal lPtr As Long) As Object
        Dim obj As Object

        CopyMemory obj, lPtr, 4
        Set ObjectFromPtr = obj
        CopyMemory obj, 0&, 4
    End Property
#End If
Public Sub RemovePropPointer()
    #If Win64 Then
        Dim lPtr As LongPtr
    #Else
        Dim lPtr As Long
    #End If

    lPtr = GetProp(hWndApplication, "ObjPtr")
    If lPtr <> 0 Then RemoveProp hWndApplication, "ObjPtr"
End Sub

Код класса: clsMsgbox

Option Explicit

Public Enum MessageBoxIcon
    NoIcon = 0
    Critical = &H10
    Question = &H20
    Exclamation = &H30
    Information = &H40
    DefaultButton1 = 0
    DefaultButton2 = &H100
    DefaultButton3 = &H200
End Enum

Public Enum MessageBoxReturn
    Unknown
    Button1
    Button2
    Button3
End Enum

Private Const m_sSource As String = "clsMsgbox"
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WH_CBT = 5
Private Const MB_TASKMODAL = &H2000&

#If Win64 Then
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr
    Private Declare PtrSafe Function MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As LongPtr
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As LongPtr
#Else
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () 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 MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
#End If

Private m_sButtonText1 As String
Private m_sButtonText2 As String
Private m_sButtonText3 As String
Private m_sPrompt As String
Private m_sTitle As String
Private m_eIcon As MessageBoxIcon
Private m_bUseCancel As Boolean

#If Win64 Then
    Private m_hInstance As LongPtr
    Private m_hThreadID As LongPtr
    Private m_lProcHook As LongPtr
#Else
    Private m_hInstance As Long
    Private m_hThreadID As Long
    Private m_lProcHook As Long
#End If

Private Sub Class_Initialize()
    #If Win64 Then
        m_hInstance = GetWindowLong(CLngPtr(hWndApplication), GWL_HINSTANCE)
    #Else
        m_hInstance = GetWindowLong(hWndApplication, GWL_HINSTANCE)
    #End If

    m_hThreadID = GetCurrentThreadId()
End Sub
Private Sub Class_Terminate()
    RemovePropPointer
End Sub
#If Win64 Then
    Public Property Get ProcHook() As LongPtr
        ProcHook = m_lProcHook
    End Property
#Else
    Public Property Get ProcHook() As Long
        ProcHook = m_lProcHook
    End Property
#End If
Public Property Get UseCancel() As Boolean
    UseCancel = m_bUseCancel
End Property
Public Property Let UseCancel(ByVal NewValue As Boolean)
    m_bUseCancel = NewValue
End Property
Public Property Let Prompt(ByVal NewValue As String)
    m_sPrompt = NewValue
End Property
Public Property Get Prompt() As String
    Prompt = m_sPrompt
End Property
Public Property Let Title(ByVal NewValue As String)
    m_sTitle = NewValue
End Property
Public Property Get Title() As String
    Title = m_sTitle
End Property
Public Property Let Icon(ByVal NewValue As MessageBoxIcon)
    m_eIcon = NewValue
End Property
Public Property Get Icon() As MessageBoxIcon
    Icon = m_eIcon
End Property
Public Property Let ButtonText1(ByVal NewValue As String)
    m_sButtonText1 = NewValue
End Property
Public Property Get ButtonText1() As String
    ButtonText1 = m_sButtonText1
End Property
Public Property Let ButtonText2(ByVal NewValue As String)
    m_sButtonText2 = NewValue
End Property
Public Property Get ButtonText2() As String
    ButtonText2 = m_sButtonText2
End Property
Public Property Let ButtonText3(ByVal NewValue As String)
    m_sButtonText3 = NewValue
End Property
Public Property Get ButtonText3() As String
    ButtonText3 = m_sButtonText3
End Property
Public Function MessageBox() As MessageBoxReturn
    Dim bCancel As Boolean

    #If Win64 Then
        Dim lR As LongPtr
        Dim lType As LongPtr
    #Else
        Dim lR As Long
        Dim lType As Long
    #End If


    If Not m_hInstance > 0 Then Err.Raise vbObjectError + 1, m_sSource, "Instance handle not found"
    If Not m_hThreadID > 0 Then Err.Raise vbObjectError + 2, m_sSource, "Thread id not found"

    If Len(Me.Title) = 0 Then Me.Title = "Microsoft Excel"
    bCancel = Me.UseCancel

    If Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) > 0 And Len(Me.ButtonText3) > 0 Then
        lType = Me.Icon Or IIf(bCancel, vbYesNoCancel, vbAbortRetryIgnore)

    ElseIf Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) Then
        lType = Me.Icon Or IIf(bCancel, vbOKCancel, vbYesNo)
    Else
        If Len(Me.ButtonText1) = 0 Then Me.ButtonText1 = "OK"
        lType = Me.Icon Or vbOKOnly
    End If

    m_lProcHook = SetWindowsHookEx(WH_CBT, _
                                   AddressOf MsgBoxHookProc, _
                                   m_hInstance, _
                                   m_hThreadID)


    'Private Declare PtrSafe Function MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As LongPtr
    'SetProp hWndApplication, "ObjPtr", PtrFromObject(Me)

    lR = MessageBoxA(hWndApplication, Me.Prompt, Me.Title, lType Or MB_TASKMODAL)

    If Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) > 0 And Len(Me.ButtonText3) > 0 Then
        If lR = IIf(bCancel, vbYes, vbAbort) Then
            MessageBox = Button1
        ElseIf lR = IIf(bCancel, vbNo, vbRetry) Then
            MessageBox = Button2
        ElseIf lR = IIf(bCancel, vbCancel, vbIgnore) Then
            MessageBox = Button3
        End If
    ElseIf Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) Then
        If lR = IIf(bCancel, vbOK, vbYes) Then
            MessageBox = Button1
        ElseIf lR = IIf(bCancel, vbCancel, vbNo) Then
            MessageBox = Button2
        End If
    Else
        If lR = vbOK Then
            MessageBox = Button1
        End If
    End If
End Function
Public Function MessageBoxEx(ByVal Prompt As String, _
                             Optional Icon As MessageBoxIcon, _
                             Optional ByVal Title As String, _
                             Optional ByVal ButtonText1 As String, _
                             Optional ByVal ButtonText2 As String, _
                             Optional ByVal ButtonText3 As String) As MessageBoxReturn

    Me.Prompt = Prompt
    Me.Icon = Icon
    Me.Title = Title
    Me.ButtonText1 = ButtonText1
    Me.ButtonText2 = ButtonText2
    Me.ButtonText3 = ButtonText3

    MessageBoxEx = MessageBox
End Function
#If Win64 Then
    Private Property Get PtrFromObject(ByRef obj As Object) As LongPtr
        PtrFromObject = ObjPtr(obj)
    End Property
#Else
    Private Property Get PtrFromObject(ByRef obj As Object) As Long
        PtrFromObject = ObjPtr(obj)
    End Property
#End If

простой код для создания окна сообщения

Sub UnitTest1()
    Dim cC As clsMsgbox
    Dim iR As Integer

    Set cC = New clsMsgbox
    iR = cC.MessageBoxEx("Do you want to save the changes you made to whatever?", Exclamation + DefaultButton2, , "&Save", "Do&n't Save", "&Cancel")
    If iR = Button1 Then
        Debug.Print "Button1 Clicked"
    ElseIf iR = Button2 Then
        Debug.Print "Button2 Clicked"
    ElseIf iR = Button3 Then
        Debug.Print "Button3 Clicked"
    End If
end sub 

Я поместил остановку в IDE, где приложение вылетает на картинке, в которой оно находится в классе. Когда строка закомментирована, код работает, но у кнопок нет назначенных им пользовательских меток.

Answer 1

Ваше объявление функции MessageBoxA неверно. Для 64-разрядной версии Office это должно быть:

Declare PtrSafe Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long

hwnd должно быть LongPtr и wType должно быть Long, а вся функция (значение возврата) должна быть Long тоже.

Вы можете посмотреть их по адресу: https://www.cadsharp.com/docs/Win32API_PtrSafe.txt

Проверьте все ваши другие объявления тоже, похоже, что некоторые другие тоже не правы.

---

Надеюсь, я все получил и ничего не наблюдал. Проверьте это:

modMsgBox

Option Explicit

Private Const HCBT_ACTIVATE = 5

Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7

#If Win64 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As LongPtr)
    Private Declare PtrSafe Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As LongPtr, ByVal lpString As String) As LongPtr
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
    Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
#End If

#If Win64 Then
    Private m_hWnd As LongPtr
#Else
    Private m_hWnd As Long
#End If

#If Win64 Then
Public Property Get hWndApplication() As LongPtr
#Else
Public Property Get hWndApplication() As Long
#End If
    If m_hWnd = 0 Then
        If Application.Name = "Microsoft Access" Then
             m_hWnd = FindWindow("OMain", vbNullString)
        ElseIf Application.Name = "Microsoft Word" Then
            m_hWnd = FindWindow("OpusApp", vbNullString)
        ElseIf Application.Name = "Microsoft Excel" Then
            m_hWnd = FindWindow("XLMAIN", vbNullString)
        End If
    End If
    hWndApplication = m_hWnd
End Property

#If Win64 Then
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                                ByVal wParam As LongPtr, _
                                ByVal lParam As LongPtr) As LongPtr
#Else
Public Function MsgBoxHookProc(ByVal uMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
#End If

    #If Win64 Then
        Dim lPtr As LongPtr
        Dim lProcHook As LongPtr
    #Else
        Dim lPtr As Long
        Dim lProcHook As Long
    #End If

    Dim cM As clsMsgbox

    Select Case uMsg
        Case HCBT_ACTIVATE
            lPtr = GetProp(hWndApplication, "ObjPtr")
            If (lPtr <> 0) Then
                Set cM = ObjectFromPtr(lPtr)
                If Not cM Is Nothing Then
                    If Len(cM.ButtonText1) > 0 And Len(cM.ButtonText2) > 0 And Len(cM.ButtonText3) > 0 Then
                        If cM.UseCancel Then
                            SetDlgItemText wParam, IDYES, cM.ButtonText1
                            SetDlgItemText wParam, IDNO, cM.ButtonText2
                            SetDlgItemText wParam, IDCANCEL, cM.ButtonText3
                        Else
                            SetDlgItemText wParam, IDABORT, cM.ButtonText1
                            SetDlgItemText wParam, IDRETRY, cM.ButtonText2
                            SetDlgItemText wParam, IDIGNORE, cM.ButtonText3
                        End If

                    ElseIf Len(cM.ButtonText1) > 0 And Len(cM.ButtonText2) Then
                        If cM.UseCancel Then
                            SetDlgItemText wParam, IDOK, cM.ButtonText1
                            SetDlgItemText wParam, IDCANCEL, cM.ButtonText2
                        Else
                            SetDlgItemText wParam, IDYES, cM.ButtonText1
                            SetDlgItemText wParam, IDNO, cM.ButtonText2
                        End If
                    Else
                        SetDlgItemText wParam, IDOK, cM.ButtonText1
                    End If
                    lProcHook = cM.ProcHook
                End If
            End If
            RemovePropPointer
            If lProcHook <> 0 Then UnhookWindowsHookEx lProcHook
    End Select

    MsgBoxHookProc = False
End Function
#If Win64 Then
    Private Property Get ObjectFromPtr(ByVal lPtr As LongPtr) As Object
        Dim obj As Object

        CopyMemory obj, lPtr, CLngPtr(4)
        Set ObjectFromPtr = obj
        CopyMemory obj, CLngPtr(0&), CLngPtr(4)
    End Property
#Else
    Private Property Get ObjectFromPtr(ByVal lPtr As Long) As Object
        Dim obj As Object

        CopyMemory obj, lPtr, 4
        Set ObjectFromPtr = obj
        CopyMemory obj, 0&, 4
    End Property
#End If
Public Sub RemovePropPointer()
    #If Win64 Then
        Dim lPtr As LongPtr
    #Else
        Dim lPtr As Long
    #End If

    lPtr = GetProp(hWndApplication, "ObjPtr")
    If lPtr <> 0 Then RemoveProp hWndApplication, "ObjPtr"
End Sub

clsMsgBox

Option Explicit

Public Enum MessageBoxIcon
    NoIcon = 0
    Critical = &H10
    Question = &H20
    Exclamation = &H30
    Information = &H40
    DefaultButton1 = 0
    DefaultButton2 = &H100
    DefaultButton3 = &H200
End Enum

Public Enum MessageBoxReturn
    Unknown
    Button1
    Button2
    Button3
End Enum

Private Const m_sSource As String = "clsMsgbox"
Private Const GWL_HINSTANCE As Long = (-6)
Private Const WH_CBT As Long = 5
Private Const MB_TASKMODAL = &H2000&

#If Win64 Then
    Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () 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 MessageBoxA Lib "user32" (ByVal hwnd As LongPtr, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    Private Declare PtrSafe Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal hData As LongPtr) As Long
#Else
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function GetCurrentThreadId Lib "kernel32" () 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 MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
#End If

Private m_sButtonText1 As String
Private m_sButtonText2 As String
Private m_sButtonText3 As String
Private m_sPrompt As String
Private m_sTitle As String
Private m_eIcon As MessageBoxIcon
Private m_bUseCancel As Boolean

#If Win64 Then
    Private m_hInstance As LongPtr
    Private m_lProcHook As LongPtr
#Else
    Private m_hInstance As Long
    Private m_lProcHook As Long
#End If

Private m_hThreadID As Long

Private Sub Class_Initialize()
    #If Win64 Then
        m_hInstance = GetWindowLongPtr(hWndApplication, GWL_HINSTANCE)
    #Else
        m_hInstance = GetWindowLong(hWndApplication, GWL_HINSTANCE)
    #End If

    m_hThreadID = GetCurrentThreadId()
End Sub
Private Sub Class_Terminate()
    RemovePropPointer
End Sub
#If Win64 Then
    Public Property Get ProcHook() As LongPtr
        ProcHook = m_lProcHook
    End Property
#Else
    Public Property Get ProcHook() As Long
        ProcHook = m_lProcHook
    End Property
#End If
Public Property Get UseCancel() As Boolean
    UseCancel = m_bUseCancel
End Property
Public Property Let UseCancel(ByVal NewValue As Boolean)
    m_bUseCancel = NewValue
End Property
Public Property Let Prompt(ByVal NewValue As String)
    m_sPrompt = NewValue
End Property
Public Property Get Prompt() As String
    Prompt = m_sPrompt
End Property
Public Property Let Title(ByVal NewValue As String)
    m_sTitle = NewValue
End Property
Public Property Get Title() As String
    Title = m_sTitle
End Property
Public Property Let Icon(ByVal NewValue As MessageBoxIcon)
    m_eIcon = NewValue
End Property
Public Property Get Icon() As MessageBoxIcon
    Icon = m_eIcon
End Property
Public Property Let ButtonText1(ByVal NewValue As String)
    m_sButtonText1 = NewValue
End Property
Public Property Get ButtonText1() As String
    ButtonText1 = m_sButtonText1
End Property
Public Property Let ButtonText2(ByVal NewValue As String)
    m_sButtonText2 = NewValue
End Property
Public Property Get ButtonText2() As String
    ButtonText2 = m_sButtonText2
End Property
Public Property Let ButtonText3(ByVal NewValue As String)
    m_sButtonText3 = NewValue
End Property
Public Property Get ButtonText3() As String
    ButtonText3 = m_sButtonText3
End Property
Public Function MessageBox() As MessageBoxReturn
    Dim bCancel As Boolean
    Dim lR As Long
    Dim lType As Long


    If Not m_hInstance > 0 Then Err.Raise vbObjectError + 1, m_sSource, "Instance handle not found"
    If Not m_hThreadID > 0 Then Err.Raise vbObjectError + 2, m_sSource, "Thread id not found"

    If Len(Me.Title) = 0 Then Me.Title = "Microsoft Excel"
    bCancel = Me.UseCancel

    If Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) > 0 And Len(Me.ButtonText3) > 0 Then
        lType = Me.Icon Or IIf(bCancel, vbYesNoCancel, vbAbortRetryIgnore)

    ElseIf Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) Then
        lType = Me.Icon Or IIf(bCancel, vbOKCancel, vbYesNo)
    Else
        If Len(Me.ButtonText1) = 0 Then Me.ButtonText1 = "OK"
        lType = Me.Icon Or vbOKOnly
    End If

    m_lProcHook = SetWindowsHookEx(WH_CBT, _
                                   AddressOf MsgBoxHookProc, _
                                   m_hInstance, _
                                   m_hThreadID)


    'Private Declare PtrSafe Function MessageBoxA Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As LongPtr) As LongPtr
    'SetProp hWndApplication, "ObjPtr", PtrFromObject(Me)

    lR = MessageBoxA(hWndApplication, Me.Prompt, Me.Title, lType Or MB_TASKMODAL)

    If Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) > 0 And Len(Me.ButtonText3) > 0 Then
        If lR = IIf(bCancel, vbYes, vbAbort) Then
            MessageBox = Button1
        ElseIf lR = IIf(bCancel, vbNo, vbRetry) Then
            MessageBox = Button2
        ElseIf lR = IIf(bCancel, vbCancel, vbIgnore) Then
            MessageBox = Button3
        End If
    ElseIf Len(Me.ButtonText1) > 0 And Len(Me.ButtonText2) Then
        If lR = IIf(bCancel, vbOK, vbYes) Then
            MessageBox = Button1
        ElseIf lR = IIf(bCancel, vbCancel, vbNo) Then
            MessageBox = Button2
        End If
    Else
        If lR = vbOK Then
            MessageBox = Button1
        End If
    End If
End Function
Public Function MessageBoxEx(ByVal Prompt As String, _
                             Optional Icon As MessageBoxIcon, _
                             Optional ByVal Title As String, _
                             Optional ByVal ButtonText1 As String, _
                             Optional ByVal ButtonText2 As String, _
                             Optional ByVal ButtonText3 As String) As MessageBoxReturn

    Me.Prompt = Prompt
    Me.Icon = Icon
    Me.Title = Title
    Me.ButtonText1 = ButtonText1
    Me.ButtonText2 = ButtonText2
    Me.ButtonText3 = ButtonText3

    MessageBoxEx = MessageBox
End Function
#If Win64 Then
    Private Property Get PtrFromObject(ByRef obj As Object) As LongPtr
        PtrFromObject = ObjPtr(obj)
    End Property
#Else
    Private Property Get PtrFromObject(ByRef obj As Object) As Long
        PtrFromObject = ObjPtr(obj)
    End Property
#End If