vba 64位程序调用SetWindowLongPtr后导致Exel重启

问题遇到的现象和发生背景

在Exel2016上编制了一个VBA64位菜单应用程序,程序中执行语句SetWindowLongPtr(hwnd, GWLP_WNDPROC, AddressOf MsgProcess)后,导致Exel重启

问题相关代码,请勿粘贴截图

'下面是窗体代码
Option Explicit
#If VBA7 And Win64 Then
'以下代码用于声明API函数及常量
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetMenu Lib "user32" (ByVal hwnd As LongPtr, ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function CreateMenu Lib "user32" () As LongPtr
Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long
Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

Private Const GWL_WNDPROC = (-4)
Private Const GWLP_WNDPROC = (-4)

Private Const MF_STRING = &H0&
Private Const MF_POPUP = &H10&
Private Const MF_SEPARATOR = &H800&
Dim MenuWnd As LongPtr, Dump As Long, PopupMenuID As LongPtr, PopupMenuWnd As LongPtr, MenuID As LongPtr

#Else

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetMenu Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long) As Long
Private Declare Function CreateMenu Lib "user32" () As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function CreatePopupMenu Lib "user32" () 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_WNDPROC = (-4)
Private Const GWLP_WNDPROC = (-4)

Private Const MF_STRING = &H0&
Private Const MF_POPUP = &H10&
Private Const MF_SEPARATOR = &H800&
Dim MenuWnd As Long, Dump As Long, PopupMenuID As Long, PopupMenuWnd As Long, MenuID As Long

#End If

'以上代码用于声明API函数及常量

Private Sub UserForm_Initialize()
Dim tmp As LongPtr
Dim xxx As Integer
If val(Application.Version) < 9 Then
hwnd = FindWindow("ThunderXFrame", Me.Caption)
Else
hwnd = FindWindow("ThunderDFrame", Me.Caption)
End If
MenuWnd = CreateMenu()
PopupMenuID = CreatePopupMenu()
Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "一点法产能评价(&Y)")
Dump = AppendMenu(PopupMenuID, MF_STRING, 100, "陈元千一点法(&Chen)")
Dump = AppendMenu(PopupMenuID, MF_STRING, 101, "长庆一点法(&ChangQ)")
Dump = AppendMenu(PopupMenuID, MF_STRING, 102, "华北一点法(&HuaBei)")
PopupMenuID = CreatePopupMenu()
Dump = AppendMenu(MenuWnd, MF_STRING, 200, "二项式产能评价(&P)")
Dump = AppendMenu(MenuWnd, MF_STRING, 300, "指数式产能评价(&P)")
Dump = AppendMenu(MenuWnd, MF_STRING, 600, "消除积液影响的气井产能评价(&P)")

PopupMenuID = CreatePopupMenu()
Dump = AppendMenu(MenuWnd, MF_STRING + MF_POPUP, PopupMenuID, "帮助(&H)")
Dump = AppendMenu(PopupMenuID, MF_STRING, 114, "版本号(&F)")
Dump = AppendMenu(PopupMenuID, MF_STRING, 115, "开发语言(&Y)")
Dump = SetMenu(hwnd, MenuWnd)
PreWinProc = GetWindowLongPtr(hwnd, GWLP_WNDPROC)
tmp = SetWindowLongPtr(hwnd, GWLP_WNDPROC, AddressOf MsgProcess)
xxx = 0
End Sub

Private Sub UserForm_Terminate()
DestroyMenu MenuWnd
DestroyMenu PopupMenuID
DestroyMenu PopupMenuWnd
SetWindowLong hwnd, GWL_WNDPROC, PreWinProc
End Sub
'上面是窗体代码

'下面是模块代码
Option Explicit
#If VBA7 And Win64 Then
'以下代码用于声明API函数及常量
Public PreWinProc As LongPtr, hwnd As LongPtr
Public Declare PtrSafe Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As LongPtr, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
Public Declare PtrSafe Function CheckMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDCheckItem As LongPtr, ByVal wCheck As Long) As Long
Public Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDEnableItem As LongPtr, ByVal wEnable As Long) As Long
Public Const MF_UNCHECKED = &H0&
Public Const MF_CHECKED = &H8&
Public Const MF_DISABLED = &H2&
Public Const MF_GRAYED = &H1&
Public Const MF_ENABLED = &H0&
Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As LongPtr, ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetMenu Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetSubMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As Long
Private Const MF_BYCOMMAND = &H0&

#Else
Public PreWinProc As Long, hwnd As Long
Public Declare Function CheckMenuRadioItem Lib "user32" (ByVal hMenu As Long, ByVal un1 As Long, ByVal un2 As Long, ByVal un3 As Long, ByVal un4 As Long) As Long
Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
Public Const MF_UNCHECKED = &H0&
Public Const MF_CHECKED = &H8&
Public Const MF_DISABLED = &H2&
Public Const MF_GRAYED = &H1&
Public Const MF_ENABLED = &H0&
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 GetMenu Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Const MF_BYCOMMAND = &H0&
#End If

Public Function MsgProcess(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongPtr) As LongPtr
Select Case wParam
Case 100
ChenYQ.Show
Case 101
ChangQing.Show
Case 102
HuaBei.Show
Case 200
TwoItem.Show
Case 300
ExpModel.Show
Case 600
LiquidLoading.Show
Case 110
MsgBox "你选择的是""二项式”录入数据""按钮!"
Case 111
MsgBox "你选择的是""“二项式”开始计算""按钮!"
Case 112
MsgBox "你选择的是""“指数式”录入数据""按钮!"
Case 113
MsgBox "你选择的是""“指数式”开始计算""按钮!"
Case 114
MsgBox "你选择的是""版本号""按钮!"
Case 115
MsgBox "你选择的是""开发语言""按钮!"
Case Else
MsgProcess = CallWindowProc(PreWinProc, hwnd, Msg, wParam, lParam)
End Select
End Function

'上面是模块代码

运行结果及报错内容

执行SetWindowLongPtr(hwnd, GWLP_WNDPROC, AddressOf MsgProcess)语句后导致Exel重启

我的解答思路和尝试过的方法

已经考虑了从32位程序到64位程序的移植,对句柄、指针、地址参数均采用LongPtr数据类型

我想要达到的结果

请帮忙解决程序运行不稳定的为你