能否在VBA的treeview控件实现右键弹出菜单功能
<P>上网搜了一下，都要用到菜单编辑器，可VBA里好像没有这个东西，不知这问题怎么解决才好。</P> 可以参考一下添加一个模块
Option Explicit
Public hwnd As Long
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINTAPI
x As Long
Y As Long
End Type
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function CreatePopupMenu Lib "user32" () As Long
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
Declare Function TrackPopupMenu& Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lprc As RECT)
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Declare Function GetMenuCheckMarkDimensions Lib "user32" () As Long
Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
在窗体中增加以下语句
Private Sub 工作目录TextBox_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single)
If Button = 2 Then '右击显示弹出式菜单
Dim CurrentPoint As POINTAPI
GetCursorPos CurrentPoint
Call ShowPopMenu_Txt(工作目录TextBox, CurrentPoint.x, CurrentPoint.Y)
End If
End Sub
Sub ShowPopMenu_Txt(ctr As MSForms.TextBox, ByVal x As Single, ByVal Y As Single)' 定义并显示弹出式菜单
Dim hMenu As Long, lOption As Long
Dim rct As RECT, iAns As Integer
hMenu = CreatePopupMenu '建立一级弹出菜单
AppendMenu hMenu, 0 Or lOption, 1, "复制"'增加菜单条目
AppendMenu hMenu, 0 Or lOption, 2, "剪切"'增加菜单条目
AppendMenu hMenu, 0 Or lOption, 3, "贴贴"'增加菜单条目
iAns = TrackPopupMenu(hMenu, 256, x, Y, 0, hwnd, rct)
'显示弹出式菜单并返回选取条目命令
Call PopMenuAction_Txt(ctr, ByVal iAns) '执行条目代码
DestroyMenu hMenu '销毁弹出菜单
End Sub
Sub PopMenuAction_Txt(ctr As MSForms.TextBox, ByVal CommandID As Integer) '执行菜单条目代码
Select Case CommandID
Case 1
ctr.Copy
Case 2
ctr.Cut
Case 3
ctr.Paste
End Select
End Sub
页:
[1]