VBA
Discuss AutoCAD ActiveX and VBA (Visual Basic for Applications) questions here.
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Right Click Menu on VBA Form simplified code?

1 REPLY 1
Reply
Message 1 of 2
metal_pro2
2229 Views, 1 Reply

Right Click Menu on VBA Form simplified code?

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)
'----------------------------------------------------------------------------------------------------

 

 

1 REPLY 1
Message 2 of 2
norman.yuan
in reply to: metal_pro2

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()

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost