copy-paste in a userform

[Hatzipavlis Stratos]

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

 

[RB Smissaert]

Look here:

http://www.mvps.org/word/FAQs/Userforms/AddRightClickMenu.htm

RBS

 

[onedaywhen]

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_NAME).ShowPopup
End If

End Sub

Private Function CreateRightClickMenu() As Boolean

On Error Resume Next
Excel.Application.CommandBars(strRIGHTCLICKMENU_NAME).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_NAME).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.