address of 问题还是解决不了.

joforn

要改就要改全套，不要改一半留一半，毕竟VBA回调很容易直接崩溃的。
另外建议调试好之后不要一直启用回调，等整个工程完成所有测试后再启用回调。
这个文件是根据你的附件改好的： TestMenu.zip (23.8 KB, 下载次数: 10)

2022-11-26 22:56 上传

点击文件名下载附件

joforn

窗体代码：

1. 
   
2. Option Explicit
   
3. 
   
4. #If VBA7 Then
   
5.   Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As LongPtr, ByVal lpWindowName As LongPtr) As LongPtr
   
6.   Private Declare PtrSafe Function SetMenu Lib "user32" (ByVal hWnd As LongPtr, ByVal hMenu As LongPtr) As Long
   
7.   Private Declare PtrSafe Function CreateMenu Lib "user32" () As LongPtr
   
8.   Private Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuW" (ByVal hMenu As LongPtr, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As LongPtr) As Long
   
9.   Private Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As Long
   
10.   Private Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
    
11.   #If Win64 Then
    
12.     Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    
13.   #Else
    
14.     Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    
15.   #End If
    
16.   
    
17.   Private hMenu As LongPtr, Dump As LongPtr, PopupMenuID As LongPtr, PopuphMenu As LongPtr, MenuId As LongPtr
    
18. #Else
    
19.   Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongW" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
20.   Private Declare Function FindWindow Lib "user32" Alias "FindWindowW" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
    
21.   Private Declare Function SetMenu Lib "user32" (ByVal hWnd As Long, ByVal hMenu As Long) As Long
    
22.   Private Declare Function CreateMenu Lib "user32" () As Long
    
23.   Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuW" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Long) As Long
    
24.   Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
    
25.   Private Declare Function CreatePopupMenu Lib "user32" () As Long
    
26.   
    
27.   Private hMenu As Long, Dump As Long, PopupMenuID As Long, PopuphMenu As Long, MenuId As Long
    
28. #End If
    
29. 
    
30. Private Const GWL_WNDPROC   As Long = -4&
    
31. Private Const MF_STRING     As Long = &H0&
    
32. Private Const MF_POPUP      As Long = &H10&
    
33. Private Const MF_SEPARATOR  As Long = &H800&
    
34. Private Const WM_SYSCOMMAND As Long = &H112
    
35. 
    
36. Private Sub UserForm_Initialize()
    
37.   If Val(Application.Version) < 9 Then
    
38.     hWnd = FindWindow(StrPtr("ThunderXFrame"), StrPtr(Me.Caption))
    
39.   Else
    
40.     hWnd = FindWindow(StrPtr("ThunderDFrame"), StrPtr(Me.Caption))
    
41.   End If
    
42. 
    
43.   hMenu = CreateMenu()
    
44.   PopupMenuID = CreatePopupMenu()
    
45.   Dump = AppendMenu(hMenu, MF_STRING + MF_POPUP, PopupMenuID, StrPtr("系统设置(&X)"))
    
46.   Dump = AppendMenu(PopupMenuID, MF_STRING, 100, StrPtr("保存(&S)..."))
    
47.   Dump = AppendMenu(PopupMenuID, MF_STRING, 101, StrPtr("备份(&E)"))
    
48.   Dump = AppendMenu(PopupMenuID, MF_SEPARATOR, 0, 0)
    
49.   Dump = AppendMenu(PopupMenuID, MF_STRING, 102, StrPtr("退出(&X)"))
    
50. 
    
51.   PopupMenuID = CreatePopupMenu()
    
52.   Dump = AppendMenu(hMenu, MF_STRING + MF_POPUP, PopupMenuID, StrPtr("会计凭证(&P)"))
    
53.   Dump = AppendMenu(PopupMenuID, MF_STRING, 110, StrPtr("录入(&L)"))
    
54.   Dump = AppendMenu(PopupMenuID, MF_STRING, 111, StrPtr("审核(&C)"))
    
55.   
    
56.   PopupMenuID = CreatePopupMenu()
    
57.   Dump = AppendMenu(hMenu, MF_STRING + MF_POPUP, PopupMenuID, StrPtr("会计账簿(&Z)"))
    
58.   Dump = AppendMenu(PopupMenuID, MF_STRING, 112, StrPtr("记账(&T)"))
    
59.   Dump = AppendMenu(PopupMenuID, MF_STRING, 113, StrPtr("结账(&J)"))
    
60.   
    
61.   PopupMenuID = CreatePopupMenu()
    
62.   Dump = AppendMenu(hMenu, MF_STRING + MF_POPUP, PopupMenuID, StrPtr("会计报表(&B)"))
    
63.   Dump = AppendMenu(PopupMenuID, MF_STRING, 114, StrPtr("资产负债表(&F)"))
    
64.   Dump = AppendMenu(PopupMenuID, MF_STRING, 115, StrPtr("损益表(&Y)"))
    
65.   Dump = SetMenu(hWnd, hMenu)
    
66. 
    
67.   PreWinProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf MsgProcess)        '把这行注释掉就能运行，但不产生关联。
    
68. End Sub
    
69. 
    
70. Private Sub UserForm_Terminate()
    
71.   DestroyMenu hMenu
    
72.   DestroyMenu PopupMenuID
    
73.   DestroyMenu PopuphMenu
    
74.   SetWindowLong hWnd, GWL_WNDPROC, PreWinProc
    
75. End Sub
    
76. 
    

复制代码

模块代码如下：

1. 
   
2. 
   
3. Option Explicit
   
4. 
   
5. #If VBA7 Then
   
6.   Public PreWinProc As LongPtr, hWnd As LongPtr
   
7.   
   
8.   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
   
9.   Public Declare PtrSafe Function CheckMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
   
10.   Public Declare PtrSafe Function EnableMenuItem Lib "user32" (ByVal hMenu As LongPtr, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
    
11. 
    
12.   Private Declare PtrSafe Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As LongPtr, ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    
13.   Private Declare PtrSafe Function GetMenu Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    
14.   Private Declare PtrSafe Function GetSubMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As LongPtr
    
15. #Else
    
16.   Public PreWinProc As Long, hWnd As Long
    
17.   
    
18.   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
    
19.   Public Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) As Long
    
20.   Public Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long
    
21. 
    
22.   Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcW" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
23.   Private Declare Function GetMenu Lib "user32" (ByVal hWnd As Long) As Long
    
24.   Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
    
25. #End If
    
26. 
    
27. Public Const MF_UNCHECKED   As Long = &H0&
    
28. Public Const MF_CHECKED     As Long = &H8&
    
29. Public Const MF_DISABLED    As Long = &H2&
    
30. Public Const MF_GRAYED      As Long = &H1&
    
31. Public Const MF_ENABLED     As Long = &H0&
    
32. Private Const MF_BYCOMMAND  As Long = &H0&
    
33. Private Const WM_COMMAND    As Long = &H111
    
34. Private Const WM_SYSCOMMAND As Long = &H112
    
35. Private Const SC_CLOSE      As Long = &HF060&
    
36. 
    
37. Private Function MenuIdClick(ByVal MenuId As Long) As Boolean
    
38.   Select Case MenuId
    
39.     Case 100
    
40.       MsgBox "你选择的是""保存""按钮!"
    
41.     Case 101
    
42.       MsgBox "你选择的是""备份""按钮!"
    
43.     Case 102
    
44.       'Unload UserForm1
    
45.     Case 110
    
46.       MsgBox "你选择的是""录入""按钮!"
    
47.     Case 111
    
48.       MsgBox "你选择的是""审核""按钮!"
    
49.     Case 112
    
50.       MsgBox "你选择的是""记账""按钮!"
    
51.     Case 113
    
52.       MsgBox "你选择的是""结账""按钮!"
    
53.     Case 114
    
54.       MsgBox "你选择的是""资产负债表""按钮!"
    
55.     Case 115
    
56.       MsgBox "你选择的是""损益表""按钮!"
    
57.     Case Else
    
58.       Exit Function
    
59.   End Select
    
60.   MenuIdClick = True
    
61. End Function
    
62. 
    
63. #If VBA7 Then
    
64.   Public Function MsgProcess(ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    
65.     If Msg = WM_COMMAND Then
    
66.       If wParam = 102& Then
    
67.         Msg = WM_SYSCOMMAND: wParam = SC_CLOSE: lParam = 0
    
68.       ElseIf MenuIdClick(CLng(wParam And &HFFFFFFFF)) Then
    
69.         Exit Function
    
70.       End If
    
71.     End If
    
72.     MsgProcess = CallWindowProc(PreWinProc, hWnd, Msg, wParam, lParam)
    
73.   End Function
    
74. #Else
    
75.   Public Function MsgProcess(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
76.     If Msg = WM_COMMAND Then
    
77.       If wParam = 102 Then
    
78.         Msg = WM_SYSCOMMAND: wParam = SC_CLOSE: lParam = 0
    
79.       ElseIf MenuIdClick(CLng(wParam And &HFFFFFFFF)) Then
    
80.         Exit Function
    
81.       End If
    
82.     End If
    
83.     MsgProcess = CallWindowProc(PreWinProc, hWnd, Msg, wParam, lParam)
    
84.   End Function
    
85. #End If
    
86. 
    

复制代码