Right click menu USER FORM

lbargers · Jul 6, 2006

Hi all,

I have some custom VBA functionality built behind an excel worksheet. One of the features that is included is a user form that pops up when a user changes the values of certain fields. A text box on the user form will capture data that is entered by a tester, I would like to allow the testers to have the ability to copy and paste cell data into the text box on the on the user form. Currently this is only possible to paste copied data into this box using the shortcut key (Ctrl-V).

I would a like a small window or menu to appear when a tester right clicks in text box to allow them to copy or paste to this field using the mouse.

Thanks in advance for any help on this issue..

Larry

BatmanUK · Jul 6, 2006

Hi Larry,

Unformtunately, a Text Box doesn't have a right-click event that you can use to fire another macro and/or form. There is a double-click event that you could use.

lbargers · Jul 6, 2006

Is there an API call that would allow this?

Legacy 98055 · Jul 6, 2006

Adding a right-click context menu to VBA UserForm TextBoxes, so that you can use the right mouse button to copy, paste, etc., as you can with normal Windows dialogs

Somebody already did the work for you. It took less than two minutes to get a right-click context menu by simply following the instructions...

Textbox_ContextMenuExample.zip

Joe Was · Jul 6, 2006

This will work, but you need to select an option and then OK or Enter after your selection to close the InputBox loop. That is enter your selection hit Enter or Click OK then without making a selection hit Enter or Click OK.

Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'UserForm module code, only!
Dim Message, Title, Default, myValue

Message = "Enter the item number for your choice:" & vbLf & vbLf & _
"1 ==> Add Current Selection to this TextBox!" & vbLf & _
"2 ==> Clear this TextBox!" & vbLf & vbLf & _
"9 ==> Cancel"

Title = "Menu!"
Default = "9"

myValue = InputBox(Message, Title, Default)

Select Case myValue

Case "9"
Exit Sub

Case ""
Exit Sub

Case "1"
TextBox1.Text = ActiveCell.Value
Exit Sub

Case "2"
TextBox1.Text = ""
Exit Sub

Case Else
MsgBox "Error, You entered: " & myValue & vbLf & _
"This is not one of the choices!"
Exit Sub

End Select
End Sub

Big Monkey · Sep 3, 2006

Adding a right-click context menu to VBA UserForm TextBoxes, so that you can use the right mouse button to copy, paste, etc., as you can with normal Windows dialogs

Somebody already did the work for you. It took less than two minutes to get a right-click context menu by simply following the instructions...

Textbox_ContextMenuExample.zip

I downloaded your example file and it works fine. When I try to add the code to my form though, it doesn't work.

It gives me a Type Mismatch error when it tries to set the focus on my text box.

Any ideas?

Legacy 98055 · Sep 3, 2006

I have no idea. Will you email me your workbook? If so, see the link below...

Big Monkey · Sep 3, 2006

I really appreciate the offer to help Right_Click.

Unfortunately, this workbook has too much proprietary information from work that I don't have the liberty to share openly.

Thanks again though.

Greg Truby · Sep 3, 2006

Didn't Juan Pablo do a blog entry some where with some examples on this?

I'd swear it was on ****'s blog, but I can't seem to find it...

Legacy 98055 · Sep 3, 2006

You are including the code in the standard module as well? Right?

Here is an example that I posted for some other fellow which will add a right click menu to every combobox and textbox on your userform...

Textbox_ComboBox_ContextMenuExample.zip

This is generic code that should work in any userform. If there happens to not be any textboxes or comboboxes, the code simply does nothing. Note that there are two other code modules that you must incorporate into your project...

This code goes into any userform:
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Private HoldReferences As Collection

 Private Sub UserForm_Initialize()
 Dim c As Control, Rccm As RightClickContextMenu

 Set HoldReferences = New Collection

 For Each c In Me.Controls
 If TypeName(c) = "TextBox" Or TypeName(c) = "ComboBox" Then
 Set Rccm = New RightClickContextMenu
 Call Rccm.SetUp(Me, c)
 HoldReferences.Add Rccm
 End If
 Next
 End Sub
</td></tr></table><button onclick='document.all("932006234013609").value=document.all("932006234013609").value.replace(/ \s\s/g,"");document.all("932006234013609").value=document.all("932006234013609").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("932006234013609").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="932006234013609" wrap="virtual">
Private HoldReferences As Collection

Private Sub UserForm_Initialize()
Dim c As Control, Rccm As RightClickContextMenu

Set HoldReferences = New Collection

For Each c In Me.Controls
If TypeName(c) = "TextBox" Or TypeName(c) = "ComboBox" Then
Set Rccm = New RightClickContextMenu
Call Rccm.SetUp(Me, c)
HoldReferences.Add Rccm
End If
Next
End Sub</textarea>

This code goes into a standard module named, "modPopupMenu":
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 'http://word.mvps.org/FAQS/Userforms/AddRightClickMenu.htm

 ' Required API declarations
 Private Declare Function CreatePopupMenu Lib "user32" () As Long
 Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
 Private 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) As Long
 Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

 ' Type required by TrackPopupMenu although this is ignored !!
 Private Type RECT
 Left As Long
 Top As Long
 Right As Long
 Bottom As Long
 End Type

 ' Type required by InsertMenuItem
 Private Type MENUITEMINFO
 cbSize As Long
 fMask As Long
 fType As Long
 fState As Long
 wID As Long
 hSubMenu As Long
 hbmpChecked As Long
 hbmpUnchecked As Long
 dwItemData As Long
 dwTypeData As String
 cch As Long
 End Type

 ' Type required by GetCursorPos
 Private Type POINTAPI
 x As Long
 y As Long
 End Type

 ' Constants required by TrackPopupMenu
 Private Const TPM_LEFTALIGN = &H0&
 Private Const TPM_TOPALIGN = &H0
 Private Const TPM_RETURNCMD = &H100
 Private Const TPM_RIGHTBUTTON = &H2&

 ' Constants required by MENUITEMINFO type
 Private Const MIIM_STATE = &H1
 Private Const MIIM_ID = &H2
 Private Const MIIM_TYPE = &H10
 Private Const MFT_STRING = &H0
 Private Const MFT_SEPARATOR = &H800
 Private Const MFS_DEFAULT = &H1000
 Private Const MFS_ENABLED = &H0
 Private Const MFS_GRAYED = &H1

 ' Contants defined by me for menu item IDs
 Private Const ID_Cut = 101
 Private Const ID_Copy = 102
 Private Const ID_Paste = 103
 Private Const ID_Delete = 104
 Private Const ID_SelectAll = 105

 ' Variables declared at module level
 Private FormCaption As String
 Private Cut_Enabled As Long
 Private Copy_Enabled As Long
 Private Paste_Enabled As Long
 Private Delete_Enabled As Long
 Private SelectAll_Enabled As Long

 Public Sub ShowPopup(oControl As Object, oForm As UserForm, strCaption As String, x, y)

 Static click_flag As Long

 ' The following is required because the MouseDown event
 ' fires twice when right-clicked !!
 click_flag = click_flag + 1

 ' Do nothing on first firing of MouseDown event
 If (click_flag Mod 2 <> 0) Then Exit Sub

 ' Set object reference to the textboxthat was clicked
 'Set oControl = oForm.ActiveControl

 ' If click is outside the textbox, do nothing
 If x > oControl.Width Or y > oControl.Height Or x < 0 Or y < 0 Then Exit Sub

 ' Retrieve caption of UserForm for use in FindWindow API
 FormCaption = strCaption

 ' Call routine that sets menu items as enabled/disabled
 Call EnableMenuItems(oControl, oForm)

 ' Call function that shows the menu and return the ID
 ' of the selected menu item. Subsequent action depends
 ' on the returned ID.
 Select Case GetSelection()
 Case ID_Cut
 oControl.Cut
 Case ID_Copy
 oControl.Copy
 Case ID_Paste
 oControl.Paste
 Case ID_Delete
 oControl.SelText = ""
 Case ID_SelectAll
 With oControl
 .SelStart = 0
 .SelLength = Len(oControl.Text)
 End With
 End Select

 End Sub

 Private Sub EnableMenuItems(oControl As Object, oForm As UserForm)

 Dim oData As DataObject
 Dim testClipBoard As String

 On Error Resume Next

 ' Set object variable to clicked textbox
 'Set oControl = oForm.ActiveControl

 ' Create DataObject to access the clipboard
 Set oData = New DataObject

 ' Enable Cut/Copy/Delete menu items if text selected
 ' in textbox
 If oControl.SelLength > 0 Then
 Cut_Enabled = MFS_ENABLED
 Copy_Enabled = MFS_ENABLED
 Delete_Enabled = MFS_ENABLED
 Else
 Cut_Enabled = MFS_GRAYED
 Copy_Enabled = MFS_GRAYED
 Delete_Enabled = MFS_GRAYED
 End If

 ' Enable SelectAll menu item if there is any text in textbox
 If Len(oControl.Text) > 0 Then
 SelectAll_Enabled = MFS_ENABLED
 Else
 SelectAll_Enabled = MFS_GRAYED
 End If

 ' Get data from clipbaord
 oData.GetFromClipboard

 ' Following line generates an error if there
 ' is no text in clipboard
 testClipBoard = oData.GetText

 ' If NO error (ie there is text in clipboard) then
 ' enable Paste menu item. Otherwise, diable it.
 If Err.Number = 0 Then
 Paste_Enabled = MFS_ENABLED
 Else
 Paste_Enabled = MFS_GRAYED
 End If

 ' Clear the error object
 Err.Clear

 ' Clean up object references
 'Set oControl = Nothing
 Set oData = Nothing

 End Sub

 Private Function GetSelection() As Long

 Dim menu_hwnd As Long
 Dim form_hwnd As Long
 Dim oMenuItemInfo1 As MENUITEMINFO
 Dim oMenuItemInfo2 As MENUITEMINFO
 Dim oMenuItemInfo3 As MENUITEMINFO
 Dim oMenuItemInfo4 As MENUITEMINFO
 Dim oMenuItemInfo5 As MENUITEMINFO
 Dim oMenuItemInfo6 As MENUITEMINFO
 Dim oRect As RECT
 Dim oPointAPI As POINTAPI

 ' Find hwnd of UserForm - note different classname
 ' Word 97 vs Word2000
 #If VBA6 Then
 form_hwnd = FindWindow("ThunderDFrame", FormCaption)
 #Else
 form_hwnd = FindWindow("ThunderXFrame", FormCaption)
 #End If

 ' Get current cursor position
 ' Menu will be drawn at this location
 GetCursorPos oPointAPI

 ' Create new popup menu
 menu_hwnd = CreatePopupMenu

 ' Intitialize MenuItemInfo structures for the 6
 ' menu items to be added

 ' Cut
 With oMenuItemInfo1
 .cbSize = Len(oMenuItemInfo1)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Cut_Enabled
 .wID = ID_Cut
 .dwTypeData = "Cut"
 .cch = Len(.dwTypeData)
 End With

 ' Copy
 With oMenuItemInfo2
 .cbSize = Len(oMenuItemInfo2)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Copy_Enabled
 .wID = ID_Copy
 .dwTypeData = "Copy"
 .cch = Len(.dwTypeData)
 End With

 ' Paste
 With oMenuItemInfo3
 .cbSize = Len(oMenuItemInfo3)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Paste_Enabled
 .wID = ID_Paste
 .dwTypeData = "Paste"
 .cch = Len(.dwTypeData)
 End With

 ' Separator
 With oMenuItemInfo4
 .cbSize = Len(oMenuItemInfo4)
 .fMask = MIIM_TYPE
 .fType = MFT_SEPARATOR
 End With

 ' Delete
 With oMenuItemInfo5
 .cbSize = Len(oMenuItemInfo5)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = Delete_Enabled
 .wID = ID_Delete
 .dwTypeData = "Delete"
 .cch = Len(.dwTypeData)
 End With

 ' SelectAll
 With oMenuItemInfo6
 .cbSize = Len(oMenuItemInfo6)
 .fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
 .fType = MFT_STRING
 .fState = SelectAll_Enabled
 .wID = ID_SelectAll
 .dwTypeData = "Select All"
 .cch = Len(.dwTypeData)
 End With

 ' Add the 6 menu items
 InsertMenuItem menu_hwnd, 1, True, oMenuItemInfo1
 InsertMenuItem menu_hwnd, 2, True, oMenuItemInfo2
 InsertMenuItem menu_hwnd, 3, True, oMenuItemInfo3
 InsertMenuItem menu_hwnd, 4, True, oMenuItemInfo4
 InsertMenuItem menu_hwnd, 5, True, oMenuItemInfo5
 InsertMenuItem menu_hwnd, 6, True, oMenuItemInfo6

 ' Return the ID of the item selected by the user
 ' and set it the return value of the function
 GetSelection = TrackPopupMenu _
 (menu_hwnd, _
 TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, _
 oPointAPI.x, oPointAPI.y, _
 0, form_hwnd, oRect)

 ' Destroy the menu
 DestroyMenu menu_hwnd

 End Function

</td></tr></table><button onclick='document.all("932006234243640").value=document.all("932006234243640").value.replace(/ \s\s/g,"");document.all("932006234243640").value=document.all("932006234243640").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("932006234243640").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="932006234243640" wrap="virtual">
Option Explicit

'http://word.mvps.org/FAQS/Userforms/AddRightClickMenu.htm

' Required API declarations
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenuItem Lib "user32" Alias "InsertMenuItemA" (ByVal hMenu As Long, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
Private 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) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

' Type required by TrackPopupMenu although this is ignored !!
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Type required by InsertMenuItem
Private Type MENUITEMINFO
cbSize As Long
fMask As Long
fType As Long
fState As Long
wID As Long
hSubMenu As Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As Long
dwTypeData As String
cch As Long
End Type

' Type required by GetCursorPos
Private Type POINTAPI
x As Long
y As Long
End Type

' Constants required by TrackPopupMenu
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_TOPALIGN = &H0
Private Const TPM_RETURNCMD = &H100
Private Const TPM_RIGHTBUTTON = &H2&

' Constants required by MENUITEMINFO type
Private Const MIIM_STATE = &H1
Private Const MIIM_ID = &H2
Private Const MIIM_TYPE = &H10
Private Const MFT_STRING = &H0
Private Const MFT_SEPARATOR = &H800
Private Const MFS_DEFAULT = &H1000
Private Const MFS_ENABLED = &H0
Private Const MFS_GRAYED = &H1

' Contants defined by me for menu item IDs
Private Const ID_Cut = 101
Private Const ID_Copy = 102
Private Const ID_Paste = 103
Private Const ID_Delete = 104
Private Const ID_SelectAll = 105

' Variables declared at module level
Private FormCaption As String
Private Cut_Enabled As Long
Private Copy_Enabled As Long
Private Paste_Enabled As Long
Private Delete_Enabled As Long
Private SelectAll_Enabled As Long

Public Sub ShowPopup(oControl As Object, oForm As UserForm, strCaption As String, x, y)

Static click_flag As Long

' The following is required because the MouseDown event
' fires twice when right-clicked !!
click_flag = click_flag + 1

' Do nothing on first firing of MouseDown event
If (click_flag Mod 2 <> 0) Then Exit Sub

' Set object reference to the textboxthat was clicked
'Set oControl = oForm.ActiveControl

' If click is outside the textbox, do nothing
If x > oControl.Width Or y > oControl.Height Or x < 0 Or y < 0 Then Exit Sub

' Retrieve caption of UserForm for use in FindWindow API
FormCaption = strCaption

' Call routine that sets menu items as enabled/disabled
Call EnableMenuItems(oControl, oForm)

' Call function that shows the menu and return the ID
' of the selected menu item. Subsequent action depends
' on the returned ID.
Select Case GetSelection()
Case ID_Cut
oControl.Cut
Case ID_Copy
oControl.Copy
Case ID_Paste
oControl.Paste
Case ID_Delete
oControl.SelText = ""
Case ID_SelectAll
With oControl
.SelStart = 0
.SelLength = Len(oControl.Text)
End With
End Select

End Sub

Private Sub EnableMenuItems(oControl As Object, oForm As UserForm)

Dim oData As DataObject
Dim testClipBoard As String

On Error Resume Next

' Set object variable to clicked textbox
'Set oControl = oForm.ActiveControl

' Create DataObject to access the clipboard
Set oData = New DataObject

' Enable Cut/Copy/Delete menu items if text selected
' in textbox
If oControl.SelLength > 0 Then
Cut_Enabled = MFS_ENABLED
Copy_Enabled = MFS_ENABLED
Delete_Enabled = MFS_ENABLED
Else
Cut_Enabled = MFS_GRAYED
Copy_Enabled = MFS_GRAYED
Delete_Enabled = MFS_GRAYED
End If

' Enable SelectAll menu item if there is any text in textbox
If Len(oControl.Text) > 0 Then
SelectAll_Enabled = MFS_ENABLED
Else
SelectAll_Enabled = MFS_GRAYED
End If

' Get data from clipbaord
oData.GetFromClipboard

' Following line generates an error if there
' is no text in clipboard
testClipBoard = oData.GetText

' If NO error (ie there is text in clipboard) then
' enable Paste menu item. Otherwise, diable it.
If Err.Number = 0 Then
Paste_Enabled = MFS_ENABLED
Else
Paste_Enabled = MFS_GRAYED
End If

' Clear the error object
Err.Clear

' Clean up object references
'Set oControl = Nothing
Set oData = Nothing

End Sub

Private Function GetSelection() As Long

Dim menu_hwnd As Long
Dim form_hwnd As Long
Dim oMenuItemInfo1 As MENUITEMINFO
Dim oMenuItemInfo2 As MENUITEMINFO
Dim oMenuItemInfo3 As MENUITEMINFO
Dim oMenuItemInfo4 As MENUITEMINFO
Dim oMenuItemInfo5 As MENUITEMINFO
Dim oMenuItemInfo6 As MENUITEMINFO
Dim oRect As RECT
Dim oPointAPI As POINTAPI

' Find hwnd of UserForm - note different classname
' Word 97 vs Word2000
#If VBA6 Then
form_hwnd = FindWindow("ThunderDFrame", FormCaption)
#Else
form_hwnd = FindWindow("ThunderXFrame", FormCaption)
#End If

' Get current cursor position
' Menu will be drawn at this location
GetCursorPos oPointAPI

' Create new popup menu
menu_hwnd = CreatePopupMenu

' Intitialize MenuItemInfo structures for the 6
' menu items to be added

' Cut
With oMenuItemInfo1
.cbSize = Len(oMenuItemInfo1)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Cut_Enabled
.wID = ID_Cut
.dwTypeData = "Cut"
.cch = Len(.dwTypeData)
End With

' Copy
With oMenuItemInfo2
.cbSize = Len(oMenuItemInfo2)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Copy_Enabled
.wID = ID_Copy
.dwTypeData = "Copy"
.cch = Len(.dwTypeData)
End With

' Paste
With oMenuItemInfo3
.cbSize = Len(oMenuItemInfo3)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Paste_Enabled
.wID = ID_Paste
.dwTypeData = "Paste"
.cch = Len(.dwTypeData)
End With

' Separator
With oMenuItemInfo4
.cbSize = Len(oMenuItemInfo4)
.fMask = MIIM_TYPE
.fType = MFT_SEPARATOR
End With

' Delete
With oMenuItemInfo5
.cbSize = Len(oMenuItemInfo5)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = Delete_Enabled
.wID = ID_Delete
.dwTypeData = "Delete"
.cch = Len(.dwTypeData)
End With

' SelectAll
With oMenuItemInfo6
.cbSize = Len(oMenuItemInfo6)
.fMask = MIIM_STATE Or MIIM_ID Or MIIM_TYPE
.fType = MFT_STRING
.fState = SelectAll_Enabled
.wID = ID_SelectAll
.dwTypeData = "Select All"
.cch = Len(.dwTypeData)
End With

' Add the 6 menu items
InsertMenuItem menu_hwnd, 1, True, oMenuItemInfo1
InsertMenuItem menu_hwnd, 2, True, oMenuItemInfo2
InsertMenuItem menu_hwnd, 3, True, oMenuItemInfo3
InsertMenuItem menu_hwnd, 4, True, oMenuItemInfo4
InsertMenuItem menu_hwnd, 5, True, oMenuItemInfo5
InsertMenuItem menu_hwnd, 6, True, oMenuItemInfo6

' Return the ID of the item selected by the user
' and set it the return value of the function
GetSelection = TrackPopupMenu _
(menu_hwnd, _
TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, _
oPointAPI.x, oPointAPI.y, _
0, form_hwnd, oRect)

' Destroy the menu
DestroyMenu menu_hwnd

End Function
</textarea>

This goes into a class module named , "RightClickContextMenu":
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Private WithEvents pTextBox As msforms.Textbox
 Private WithEvents pComboBox As msforms.ComboBox

 Private pUserFormReference As UserForm

 Private Sub pComboBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
 If Button = 2 Then
 Call ShowPopup(pComboBox, pUserFormReference, pUserFormReference.Caption, x, y)
 End If
 End Sub

 Private Sub pTextBox_MouseDown(ByVal Button As Integer, _
 ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
 If Button = 2 Then
 Call ShowPopup(pTextBox, pUserFormReference, pUserFormReference.Caption, x, y)
 End If
 End Sub

 Public Sub SetUp(UserFormReference As UserForm, ControlReference As Control)
 Set pUserFormReference = UserFormReference
 Select Case TypeName(ControlReference)
 Case "TextBox": Set pTextBox = ControlReference
 Case "ComboBox": Set pComboBox = ControlReference
 End Select
 End Sub

</td></tr></table><button onclick='document.all("932006234351937").value=document.all("932006234351937").value.replace(/ \s\s/g,"");document.all("932006234351937").value=document.all("932006234351937").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("932006234351937").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="932006234351937" wrap="virtual">
Option Explicit

Private WithEvents pTextBox As msforms.Textbox
Private WithEvents pComboBox As msforms.ComboBox

Private pUserFormReference As UserForm

Private Sub pComboBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 2 Then
Call ShowPopup(pComboBox, pUserFormReference, pUserFormReference.Caption, x, y)
End If
End Sub

Private Sub pTextBox_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
If Button = 2 Then
Call ShowPopup(pTextBox, pUserFormReference, pUserFormReference.Caption, x, y)
End If
End Sub

Public Sub SetUp(UserFormReference As UserForm, ControlReference As Control)
Set pUserFormReference = UserFormReference
Select Case TypeName(ControlReference)
Case "TextBox": Set pTextBox = ControlReference
Case "ComboBox": Set pComboBox = ControlReference
End Select
End Sub
</textarea>

Perhaps the code from the standard mod could be incorporated into the class as well??? Don't know...

Textbox_ComboBox_ContextMenuExample.zip

Right click menu USER FORM

lbargers

New Member

Excel Facts

BatmanUK

Board Regular

lbargers

New Member

Legacy 98055

Guest

Joe Was

MrExcel MVP

Big Monkey

Active Member

Legacy 98055

Guest

Big Monkey

Active Member

Greg Truby

MrExcel MVP

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

Right click menu USER FORM

lbargers

New Member

Excel Facts

BatmanUK

Board Regular

lbargers

New Member

Legacy 98055

Guest

Joe Was

MrExcel MVP

Big Monkey

Active Member

Legacy 98055

Guest

Big Monkey

Active Member

Greg Truby

MrExcel MVP

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock