need a right click menu on the userform---> VBA

[sudhakar]

hello,

i am working on VBA..

i need a rightclick menu. when right click on the Userform.

please can anyone help me..


thanks in advance
sudhakar

 

[Andrew Poulsom]

Maybe you could put a ComboBox in another UserForm to act as a menu. Then you can do something like this:

' UserForm1 module

Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button <> 2 Then Exit Sub
    Me.Hide
    UserForm2.Show
End Sub

' UserForm2 module

Private Sub CommandButton1_Click()
    Me.Hide
    UserForm1.Show
End Sub

 

[Juan Pablo González]

What follows is my way to provide a right click menu with a "Copy" command, to use on TextBoxes. This form only has two textboxes, labRegA and labRegB:

In the userform module:

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>

<SPAN style="color:#00007F">Dim</SPAN> PopBar <SPAN style="color:#00007F">As</SPAN> CommandBar
<SPAN style="color:#00007F">Dim</SPAN> PopVisible <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> labRegA_MouseDown(<SPAN style="color:#00007F">ByVal</SPAN> Button <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Shift <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>)
    <SPAN style="color:#00007F">If</SPAN> Button = 2 And Shift = 0 <SPAN style="color:#00007F">Then</SPAN>
        PopVisible = PopVisible + 1
        <SPAN style="color:#00007F">If</SPAN> PopVisible Mod 2 = 1 <SPAN style="color:#00007F">Then</SPAN>
            MyText = labRegA.Text
            PopBar.ShowPopup
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> labRegB_MouseDown(<SPAN style="color:#00007F">ByVal</SPAN> Button <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> Shift <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> x <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>, <SPAN style="color:#00007F">ByVal</SPAN> y <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Single</SPAN>)
    <SPAN style="color:#00007F">If</SPAN> Button = 2 And Shift = 0 <SPAN style="color:#00007F">Then</SPAN>
        PopVisible = PopVisible + 1
        <SPAN style="color:#00007F">If</SPAN> PopVisible Mod 2 = 1 <SPAN style="color:#00007F">Then</SPAN>
            MyText = labRegB.Text
            PopBar.ShowPopup
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>

<SPAN style="color:#00007F">Private</SPAN> <SPAN style="color:#00007F">Sub</SPAN> UserForm_Initialize()
    <SPAN style="color:#00007F">Dim</SPAN> PopButton <SPAN style="color:#00007F">As</SPAN> CommandBarButton
    
    <SPAN style="color:#00007F">Set</SPAN> PopBar = Application.CommandBars.Add(, msoBarPopup, <SPAN style="color:#00007F">False</SPAN>, <SPAN style="color:#00007F">True</SPAN>)
    <SPAN style="color:#00007F">Set</SPAN> PopButton = PopBar.Controls.Add(msoControlButton)
    <SPAN style="color:#00007F">With</SPAN> PopButton
        .Caption = "&Copy"
        .FaceId = 19
        .OnAction = "CopyText"
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN>
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

and in a standard module:

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN>

<SPAN style="color:#00007F">Public</SPAN> MyText <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>

<SPAN style="color:#00007F">Sub</SPAN> CopyText()
    <SPAN style="color:#00007F">Dim</SPAN> MyDO <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">New</SPAN> DataObject
    MyDO.SetText MyText
    MyDO.PutInClipboard
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN>
</FONT>

 

[Haluk]

An alternative:

All the below stuff goes in the UserForm's code module;

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
'
Private Sub UserForm_Initialize()
    hWnd = FindWindow(vbNullString, Me.Caption)
End Sub
'
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 Dim Pt As POINTAPI
    Dim ret As Long
    If Button = 2 Then
        hMenu = CreatePopupMenu()
        AppendMenu hMenu, MF_STRING, 1, "Menu - 1"
        AppendMenu hMenu, MF_STRING, 2, "Menu - 2"
        AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
        AppendMenu hMenu, MF_STRING, 4, "About"
        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
                Call MenuProc1
                Case 2
                Call MenuProc2
                Case 4
                Call MenuProc3
            End Select
    End If
End Sub
'
Private Sub MenuProc1()
    MsgBox "PopUp menu-1 is activated !"
End Sub
'
Private Sub MenuProc2()
    MsgBox "PopUp menu-2 is activated !"
End Sub
'
Private Sub MenuProc3()
    MsgBox "Prepared by Raider ®"
End Sub

 

[sudhakar]

hello,

Thanks For all... these examples worked fine...

especially for "Raider"

Thanks once again
Sudhakar