I'm a creating a Right Click Menu on VBA Form to copy and paste text in Textboxes. I have got the code to work on one textboxt named "TextCat" in the Mouse up event. I would like to be able to use the same code on all textboxes (some in frames) on a form without having to duplicate this long bit of code and change the textbox name multiple times for every different textbox mouse up event. Any sugestions for a beginner to simplify the code ?
.
Here is the code for a textbox "TextCAt" mouseup
Private Sub TextCAt_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) '---------------------------------------------------------------------------------------------------- 'Right Click Menu Dim Pt As POINTAPI Dim ret As Long If Button = 2 Then hMenu = CreatePopupMenu() AppendMenu hMenu, MF_STRING, 1, "Cut" AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0& AppendMenu hMenu, MF_STRING, 2, "Copy" AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0& AppendMenu hMenu, MF_STRING, 4, "Paste" GetCursorPos Pt ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, Pt.X, Pt.Y, hWnd, ByVal 0&) DestroyMenu hMenu Select Case ret Case 1 'Cut TextCAt.SelStart = 0 TextCAt.SelLength = TextCAt.TextLength TextCAt.Cut Case 2 'Copy TextCAt.SelStart = 0 TextCAt.SelLength = TextCAt.TextLength TextCAt.Copy Case 4 'Paste TextCAt.SelStart = 0 TextCAt.SelLength = TextCAt.TextLength TextCAt.Paste End Select End If End Sub
These are at the very begining of the userform code
'---------------------------------------------------------------------------------------------------- 'Right Click Menu Private Type POINTAPI X As Long Y As Long End Type ' Private Declare Function CreatePopupMenu Lib "user32" () As Long Private Declare Function TrackPopupMenuEx Lib "user32" _ (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, _ ByVal hWnd As Long, ByVal lptpm As Any) 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 GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long ' Const MF_CHECKED = &H8& Const MF_APPEND = &H100& Const TPM_LEFTALIGN = &H0& Const MF_SEPARATOR = &H800& Const MF_STRING = &H0& Const TPM_RETURNCMD = &H100& Const TPM_RIGHTBUTTON = &H2& ' Dim hMenu As Long Dim hWnd As Long ''Right Click Menu '----------------------------------------------------------------------------------------------------
and under userform initialize
'Right Click Menu hWnd = FindWindow(vbNullString, Me.Caption) '----------------------------------------------------------------------------------------------------
You can create a class that raise its own event in each textbox' mouse_up event handler. Then the event handler that handles your class' custom event becomes the single place you need to have code deal with the input in all the textboxes.
For example, there is a form with 2 text boxes.
Firstly, create a class like this:
Option Explicit Public Event RightClicked() Public TextBoxName As String Public TextBoxText As String Public Sub RightClickTextBox(txt As TextBox) TextBoxName = txt.Name TextBoxText = txt.Text RaiseEvent RightClicked End Sub
Then in the form's code:
Option Explicit Private WithEvents txtHandler As TextBoxHandler Private Sub TextBoxRightMouseButtonClicked(txt As TextBox) Set txtHandler = New TextBoxHandler ''Execute this method raises custom event
txtHandler.RightClickTextBox txt End Sub Private Sub txtHandler_RightClicked() Dim txtBoxName As String Dim txtBoxText As String ''Know which text box is right-clicked and ''the text value entered txtBoxName = txtHandler.TextBoxName txtBoxText = txtHandler.TextBoxText ''Here is the single location to deal with ''the textbox's data when textbox is right clicked MsgBox "Right-clicked textbox: " & txtBoxName & vbCr & "TextBox.Text=" & txtBoxText End Sub Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 2 Then TextBoxRightMouseButtonClicked TextBox2 End If End Sub Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button = 2 Then TextBoxRightMouseButtonClicked TextBox1 End If End Sub Private Sub UserForm_Initialize() Set txtHandler = Nothing End Sub
As you can see, you do not have to repeat the similar detailed code in each textbox's MouseUp event handler. Instead, you deal with textbox's input in the custom event handler txtHandler_RighClicked()