copy-paste in a userform
i would like to know how i can activate
the right mouse button menu (copy, cut, paste etc) when i am inserting data in a userform's textbox thanx |
copy-paste in a userform
Look he
http://www.mvps.org/word/FAQs/Userfo...tClickMenu.htm RBS "Hatzipavlis Stratos" wrote in message ... i would like to know how i can activate the right mouse button menu (copy, cut, paste etc) when i am inserting data in a userform's textbox thanx |
copy-paste in a userform
1. Add a new userform called Userform1
2. Add a textbox called TextBox1 3. Paste the following into the userform's code module: 1. Add a new userfor m '------------------------------------------------ Option Explicit Private Const strRIGHTCLICKMENU_NAME As String = "MyRightClickMenu" Private Sub UserForm_Initialize() CreateRightClickMenu End Sub Private Sub UserForm_Terminate() KillRightClickMenu 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 Excel.Application.CommandBars(strRIGHTCLICKMENU_NA ME).ShowPopup End If End Sub Private Function CreateRightClickMenu() As Boolean On Error Resume Next Excel.Application.CommandBars(strRIGHTCLICKMENU_NA ME).Delete On Error GoTo 0 With CommandBars.Add(strRIGHTCLICKMENU_NAME, msoBarPopup) With .Controls.Add(msoControlButton) .Caption = "Cut" .FaceId = 21 .OnAction = "MenuCut" End With With .Controls.Add(msoControlButton) .Caption = "Copy" .FaceId = 19 .OnAction = "MenuCopy" End With With .Controls.Add(msoControlButton) .Caption = "Paste" .FaceId = 22 .OnAction = "MenuPaste" End With End With CreateRightClickMenu = True End Function Private Sub KillRightClickMenu() On Error Resume Next Excel.Application.CommandBars(strRIGHTCLICKMENU_NA ME).Delete On Error GoTo 0 End Sub '------------------------------------------------ 4. Add a standard module and paste in the following code: '------------------------------------------------ Option Explicit Public Sub MenuCut() Dim strTextToAdd As String Dim DataObject1 As DataObject Dim ctlActive As MSForms.Control On Error GoTo Err_Handler If UserForm1.Visible = False Then Unload UserForm1 Exit Sub End If Set DataObject1 = New DataObject Set ctlActive = UserForm1.ActiveControl Do Until Not TypeOf ctlActive Is MSForms.Frame Set ctlActive = ctlActive.ActiveControl Loop strTextToAdd = ctlActive.SelText If Len(strTextToAdd) 0 Then With DataObject1 .SetText strTextToAdd .PutInClipboard End With ctlActive.SelText = vbNullString End If Err_Handler: Set DataObject1 = Nothing End Sub Public Sub MenuCopy() Dim strTextToAdd As String Dim DataObject1 As DataObject Dim ctlActive As MSForms.Control On Error GoTo Err_Handler If UserForm1.Visible = False Then Unload UserForm1 Exit Sub End If Set DataObject1 = New DataObject Set ctlActive = UserForm1.ActiveControl Do Until Not TypeOf ctlActive Is MSForms.Frame Set ctlActive = ctlActive.ActiveControl Loop strTextToAdd = ctlActive.SelText If Len(strTextToAdd) 0 Then With DataObject1 .SetText strTextToAdd .PutInClipboard End With End If Err_Handler: Set DataObject1 = Nothing End Sub Public Sub MenuPaste() Dim strTextToAdd As String Dim DataObject1 As DataObject Dim ctlActive As MSForms.Control On Error GoTo Err_Handler If UserForm1.Visible = False Then Unload UserForm1 Exit Sub End If Set DataObject1 = New DataObject DataObject1.GetFromClipboard strTextToAdd = DataObject1.GetText() If Len(strTextToAdd) 0 Then Set ctlActive = UserForm1.ActiveControl Do Until Not TypeOf ctlActive Is MSForms.Frame Set ctlActive = ctlActive.ActiveControl Loop ctlActive.SelText = strTextToAdd End If Err_Handler: Set DataObject1 = Nothing End Sub '------------------------------------------------ 5. Run the userform, type some text in the textbox, right click and try out the menu items. "Hatzipavlis Stratos" wrote in message ... i would like to know how i can activate the right mouse button menu (copy, cut, paste etc) when i am inserting data in a userform's textbox thanx |
All times are GMT +1. The time now is 08:16 PM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com