باسلام
آیا امکان داره وقتی داخل تکست باکس یوزرفرم راست کلیک کنی منوی copy و paste و ... باز بشه؟
ممنون
آیا امکان داره وقتی داخل تکست باکس یوزرفرم راست کلیک کنی منوی copy و paste و ... باز بشه؟
ممنون
Sub MakePopUp()
'Remove any old instance of MyPopUp
On Error Resume Next
CommandBars("MyPopUp").Delete
On Error GoTo 0
With CommandBars.Add(Name:="MyPopUp", Position:=msoBarPopup)
.Controls.Add Type:=msoControlButton, ID:=19
.Controls.Add Type:=msoControlButton, ID:=22
End With
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MakePopUp
If Button = 2 Then
Application.CommandBars("MyPopUp").ShowPopup
End If
End Sub
Sub MakePopUp()
'Remove any old instance of MyPopUp
On Error Resume Next
CommandBars("MyPopUp").Delete
On Error GoTo 0
With CommandBars.Add(Name:="MyPopUp", Position:=msoBarPopup)
.Controls.Add Type:=msoControlButton, ID:=19
.Controls.Add Type:=msoControlButton, ID:=22
End With
End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MakePopUp
If Button = 2 Then
Application.CommandBars("MyPopUp").ShowPopup
End If
End Sub
sub makepopup()
'remove any old instance of mypopup
on error resume next
commandbars("mypopup").delete
on error goto 0
with commandbars.add(name:="mypopup", position:=msobarpopup)
.controls.add type:=msocontrolbutton, id:=19
.controls.add type:=msocontrolbutton, id:=22
end with
end sub
private sub textbox1_mouseup(byval button as integer, byval shift as integer, byval x as single, byval y as single)
makepopup
if button = 2 then
application.commandbars("mypopup").showpopup
end if
end sub
CommandBars("MyPopUp").Controls(1).OnAction = "CopyText" CommandBars("MyPopUp").Controls(2).OnAction = "PasteText"
' Action Copy Private Sub CopyText() Set txtData = New DataObject txtData.SetText fullint.TextBox1.SelText txtData.PutInClipboard End Sub ' Action Paste Private Sub PasteText() fullint.TextBox1.Paste End Sub
Sub MakePopUp() 'Remove any old instance of MyPopUp On Error Resume Next CommandBars("MyPopUp").Delete On Error GoTo 0 With CommandBars.Add(name:="MyPopUp", Position:=msoBarPopup) .Controls.Add Type:=msoControlButton, ID:=19 .Controls.Add Type:=msoControlButton, ID:=22 End With CommandBars("MyPopUp").Controls(1).OnAction = "CopyText" CommandBars("MyPopUp").Controls(2).OnAction = "PasteText" End Sub
' Action CopyPrivate Sub CopyText() Set txtData = New DataObject txtData.SetText fullint.TextBox1.SelText txtData.PutInClipboard End Sub
' Action PastePrivate Sub PasteText() fullint.TextBox1.Paste End Sub
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) MakePopUp If Button = 2 Then Application.CommandBars("MyPopUp").ShowPopup End If End Sub
Sub MakePopUp(field As String) 'Remove any old instance of MyPopUp On Error Resume Next CommandBars("MyPopUp").Delete On Error GoTo 0 With CommandBars.Add(name:="MyPopUp", Position:=msoBarPopup) .Controls.Add Type:=msoControlButton, ID:=19 .Controls.Add Type:=msoControlButton, ID:=22 End With CommandBars("MyPopUp").Controls(1).OnAction = "'CopyText """ & field & """'" CommandBars("MyPopUp").Controls(2).OnAction = "'PasteText """ & field & """'" End Sub ' Action Copy Sub CopyText(tb As String) Set txtData = New DataObject txtData.SetText fullint.Controls(tb).SelText txtData.PutInClipboard End Sub ' Action Paste Sub PasteText(tb As String) fullint.Controls(tb).Paste End Sub
MakePopUp "TextBox1"
کامنت