Userform Control Paste
 

In a userform TextBox, how can I enable a paste function?

Having copied a text string from another application, I
now wish to paste this into an open Excel userform, using
the right mouse click-paste option. Is this possible?

Using XL97

Cheers
Nigel

Userform Control Paste
 

Hi Nigel,
In UserForm module:
Private xOffset As Single, yOffset As Single

Private Sub TextBox1_MouseDown(ByVal Button As Integer _
, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then Call PopUpMenuConfig(X, Y)
End Sub

Private Sub UserForm_Initialize()
xOffset = (Me.Width - Me.InsideWidth) / 2
yOffset = Me.Height - Me.InsideHeight - xOffset
Call PopUpMenuCreate
End Sub

Private Sub PopUpMenuDelete(ByVal PopUpMenuName As String)
On Error Resume Next
CommandBars(PopUpMenuName).Delete
End Sub

Private Sub PopUpMenuCreate()
Call PopUpMenuDelete("PopUpCb")
Dim cb As CommandBar
Set cb = CommandBars.Add("PopUpCb", msoBarPopup, False, True)
With cb.Controls.Add(msoControlButton, 1, , , True)
..Caption = "C&oller"
..Style = msoButtonIconAndCaption
..FaceId = 111
..OnAction = ThisWorkbook.Name & "!PopUpMenuItem"
End With
Set cb = Nothing
End Sub

Private Function xPos(X As Single) As Single
' Points - Pixels
xPos = (Me.Left + xOffset + Me.ActiveControl.Left + X) * 4 / 3
End Function

Private Function yPos(Y As Single) As Single
' Points - Pixels
yPos = (Me.Top + yOffset + Me.ActiveControl.Top + Y) * 4 / 3
End Function

Private Sub UserForm_QueryClose(Cancel As Integer _
, CloseMode As Integer)
Call PopUpMenuDelete("PopUpCb")
End Sub

Private Sub PopUpMenuConfig(X As Single, Y As Single)
Static Click As Integer: Click = Click + 1
If Not Click Mod 2 = 0 Then Exit Sub
Dim objData As DataObject, DataText As String
Set objData = New DataObject
objData.GetFromClipboard
On Error Resume Next
DataText = objData.GetText
Application.CommandBars("PopUpCb") _
..Controls(1).Enabled = (Err.Number = 0)
Err.Clear: Set objData = Nothing
Application.CommandBars("PopUpCb") _
..ShowPopup xPos(X), yPos(Y)
End Sub

In Standard module:
Sub PopUpMenuItem(Optional dummy% = 1)
UserForm1.ActiveControl.Paste
End Sub

Regards,
MP

"Nigel" a écrit dans le message de
...
In a userform TextBox, how can I enable a paste function?

Having copied a text string from another application, I
now wish to paste this into an open Excel userform, using
the right mouse click-paste option. Is this possible?

Using XL97

Cheers
Nigel

Userform Control Paste
 

Hi Michel
Thanks for the code, I think I know what it is trying to do. I set it up as
you suggested but if I right click the mouse in the Textbox1 nothing
happens!
I have cheked the mouse Button #2 is triggering the code but the pop up does
not appear. Not sure why?

Any thoughts?

--
Cheers
Nigel



"Michel Pierron" wrote in message
...
Hi Nigel,
In UserForm module:
Private xOffset As Single, yOffset As Single

Private Sub TextBox1_MouseDown(ByVal Button As Integer _
, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then Call PopUpMenuConfig(X, Y)
End Sub

Private Sub UserForm_Initialize()
xOffset = (Me.Width - Me.InsideWidth) / 2
yOffset = Me.Height - Me.InsideHeight - xOffset
Call PopUpMenuCreate
End Sub

Private Sub PopUpMenuDelete(ByVal PopUpMenuName As String)
On Error Resume Next
CommandBars(PopUpMenuName).Delete
End Sub

Private Sub PopUpMenuCreate()
Call PopUpMenuDelete("PopUpCb")
Dim cb As CommandBar
Set cb = CommandBars.Add("PopUpCb", msoBarPopup, False, True)
With cb.Controls.Add(msoControlButton, 1, , , True)
.Caption = "C&oller"
.Style = msoButtonIconAndCaption
.FaceId = 111
.OnAction = ThisWorkbook.Name & "!PopUpMenuItem"
End With
Set cb = Nothing
End Sub

Private Function xPos(X As Single) As Single
' Points - Pixels
xPos = (Me.Left + xOffset + Me.ActiveControl.Left + X) * 4 / 3
End Function

Private Function yPos(Y As Single) As Single
' Points - Pixels
yPos = (Me.Top + yOffset + Me.ActiveControl.Top + Y) * 4 / 3
End Function

Private Sub UserForm_QueryClose(Cancel As Integer _
, CloseMode As Integer)
Call PopUpMenuDelete("PopUpCb")
End Sub

Private Sub PopUpMenuConfig(X As Single, Y As Single)
Static Click As Integer: Click = Click + 1
If Not Click Mod 2 = 0 Then Exit Sub
Dim objData As DataObject, DataText As String
Set objData = New DataObject
objData.GetFromClipboard
On Error Resume Next
DataText = objData.GetText
Application.CommandBars("PopUpCb") _
.Controls(1).Enabled = (Err.Number = 0)
Err.Clear: Set objData = Nothing
Application.CommandBars("PopUpCb") _
.ShowPopup xPos(X), yPos(Y)
End Sub

In Standard module:
Sub PopUpMenuItem(Optional dummy% = 1)
UserForm1.ActiveControl.Paste
End Sub

Regards,
MP

"Nigel" a écrit dans le message de
...
In a userform TextBox, how can I enable a paste function?

Having copied a text string from another application, I
now wish to paste this into an open Excel userform, using
the right mouse click-paste option. Is this possible?

Using XL97

Cheers
Nigel