Results 1 to 5 of 5

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

This is a discussion on need a right click menu on the userform---> VBA within the Excel Questions forums, part of the Question Forums category; hello, i am working on VBA .. i need a rightclick menu. when right click on the Userform. please can ...

  1. #1
    New Member
    Join Date
    Jul 2004
    Posts
    4

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

    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

  2. #2
    MrExcel MVP
    Moderator
    Andrew Poulsom's Avatar
    Join Date
    Jul 2002
    Posts
    69,332

    Default Re: need a right click menu on the userform---> VBA

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

    Code:
    ' 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

  3. #3
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Bogota, Colombia
    Posts
    11,950

    Default Re: need a right click menu on the userform---> VBA

    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:

    Option Explicit

    Dim PopBar As CommandBar
    Dim PopVisible As Long

    Private Sub labRegA_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    ****If Button = 2 And Shift = 0 Then
    ********PopVisible = PopVisible + 1
    ********If PopVisible Mod 2 = 1 Then
    ************MyText = labRegA.Text
    ************PopBar.ShowPopup
    ********End If
    ****End If
    End Sub

    Private Sub labRegB_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    ****If Button = 2 And Shift = 0 Then
    ********PopVisible = PopVisible + 1
    ********If PopVisible Mod 2 = 1 Then
    ************MyText = labRegB.Text
    ************PopBar.ShowPopup
    ********End If
    ****End If
    End Sub

    Private Sub UserForm_Initialize()
    ****Dim PopButton As CommandBarButton
    ****
    ****Set PopBar = Application.CommandBars.Add(, msoBarPopup, False, True)
    ****Set PopButton = PopBar.Controls.Add(msoControlButton)
    ****With PopButton
    ********.Caption = "&Copy"
    ********.FaceId = 19
    ********.OnAction = "CopyText"
    ****End With
    End Sub


    and in a standard module:

    Option Explicit

    Public MyText As String

    Sub CopyText()
    ****Dim MyDO As New DataObject
    ****MyDO.SetText MyText
    ****MyDO.PutInClipboard
    End Sub
    Regards,

    Juan Pablo González
    http://www.juanpg.com

  4. #4
    Board Regular Haluk's Avatar
    Join Date
    Oct 2002
    Location
    Turkiye
    Posts
    832

    Default Re: need a right click menu on the userform---> VBA

    An alternative:

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

    Code:
    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

  5. #5
    New Member
    Join Date
    Jul 2004
    Posts
    4

    Default Re: need a right click menu on the userform---> VBA

    hello,

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

    especially for "Raider"

    Thanks once again
    Sudhakar

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  


DMCA.com