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
