[VBA]为什么文本框没有右键功能？

myfreemind

可能是没有，没有CLICK事件

zfbj

VBA只能看作VB的一个子集，这种功能可以通过截获控件的相关消息来实现。（使用相关的API函数）

zeng29

简单点的方法是使用VB编写的DLL.

asd_10000

添加一个模块

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