Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 895
  • Last Modified:

VBA for Excel - PopUp Menu in a Multipages

good morning to everybody!  
 
in the link that I bring here   -  http://word.mvps.org/FAQS/Userforms/AddRightClickMenu.htm -  

following you is pointed out as it realizes a context menu in one  textbox of an userform
 
In the Userform of my project    there is a textbox in Multipage  
 
I wanted to kindly ask you, if you know what necessary to modify of this is  
 
form to make it compatible with a Multuipage of an userform
0
lucamongelluzzi2009
Asked:
lucamongelluzzi2009
  • 5
  • 4
1 Solution
 
borgunitCommented:
Would you just want to use textboxes still on each page and code accordingly as before?
0
 
lucamongelluzzi2009Author Commented:
this answer is strange but it doesn't cath me.

i hope thatm after having made the signature for 6 months, you can give me a

answer more consistent with how much writing in the question!!!

Regard

LM

REPEAT ----------------------------------------------------------------

in the link that I bring here   -  http://word.mvps.org/FAQS/Userforms/AddRightClickMenu.htm -  

following you is pointed out as it realizes a context menu in one  textbox of an

userform In the Userform of my project    there is a textbox in Multipage  
 
I wanted to kindly ask you, if you know what necessary to modify of this is  
 
form to make it compatible with a Multuipage of an userform

Re - Regard
0
 
hiteshgoldeneyeCommented:
Hi could you upload a sample file? that would be helpful
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
lucamongelluzzi2009Author Commented:
in the example under brought (you open file) in the sheet 1 there are two buttons  
 
The first one opens an userform with a textbox for which it is possible  
 
with the right clik of the mouse to make to appear the context menu  
 
In the second case this is not possible to do it causes the presence of the

multiple pages.  In the userform 2 that they are not compatible with the code

write in the.  ".bas" :  "modPopupMenu.bas."

regards and Tks
popUp-Menu-Userform.xls
0
 
hiteshgoldeneyeCommented:
hi u can try using the following for the multipage control userform



Public Sub ShowPopup(oForm As UserForm, strCaption As String, X As Single, Y As Single)

    Dim oControl As MSForms.TextBox
    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.SelectedItem.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(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
0
 
hiteshgoldeneyeCommented:
Use this instead

Public Sub ShowPopup(oForm As UserForm, strCaption As String, X As Single, Y As Single)
 
    Dim oControl As MSForms.TextBox
    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
    
    If TypeOf oForm.ActiveControl Is TextBox Then
       Set oControl = oForm.ActiveControl
    Else
       Set oControl = oForm.ActiveControl.SelectedItem.ActiveControl
    End If
    ' 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(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(oForm As UserForm)
 
    Dim oControl As MSForms.TextBox
    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

Open in new window

0
 
lucamongelluzzi2009Author Commented:
kind gentleman  
 
I sincerely thank you for help me
 
I have noticed that the change to be brought concerns  
 
Set oControl = oForm.ActiveControl.SelectedItem.ActiveControl  
 
I would like to ask her if possible a last information  
 
you can kindly tell me what change is necessary for showing a contex menu

when the textbox both in a  frame (you see attached example : button 2)?

I would be indeed her thankful if explained me the logic with which the changes are brought to the case!!!  
 
regards and graces still
popUp-Menu-Userform.xls
0
 
hiteshgoldeneyeCommented:
In this case you will have to use the following code

Regarding the logic, note that if the selected  control is a textbox then we can simply use Set oControl = oForm.ActiveControl

but if the textbox is in Multipage Control then we need to use
Set oControl = oForm.ActiveControl.SelectedItem.ActiveControl  
 
and if it is in a frame within a multipage control then use
Set oControl = oForm.ActiveControl.SelectedItem.ActiveControl.ActiveControl



Public Sub ShowPopup(oForm As UserForm, strCaption As String, X As Single, Y As Single)
 
    Dim oControl As MSForms.TextBox
    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
    If TypeOf oForm.ActiveControl Is TextBox Then
        Set oControl = oForm.ActiveControl
    Else
                  Set oControl = oForm.ActiveControl.SelectedItem.ActiveControl.ActiveControl
      
    End If
    ' 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(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

Open in new window

0
 
lucamongelluzzi2009Author Commented:
I thank a lot her for his/her help  
 
and thank you for having explained me the logic with which the code must be modified  
 
Regards  
 
Luca Mongelluzzi
0
 
hiteshgoldeneyeCommented:
HI Luca if your problem is solved you can close by accepting the solution
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now