標準では右クリックメニューがでないので
わざわざ追加しないといけない。
===== フォームモジュール(MyUserForm) =====
Option Explicit
'クラスのインスタンス保持用
Private colText As Collection
Private Sub UserForm_Initialize()
Dim myCopy As cCopyPaste
Dim myText As MSForms.Control
Set colText = New Collection
'TextBoxとComboBoxに対して設定する
For Each myText In Me.Controls
If TypeOf myText Is MSForms.TextBox Then
Set myCopy = New cCopyPaste
Set myCopy.Text = myText
colText.Add myCopy
ElseIf TypeOf myText Is MSForms.ComboBox Then
Set myCopy = New cCopyPaste
Set myCopy.Comb = myText
colText.Add myCopy
End If
Next
End Sub
Private Sub UserForm_Terminate()
Dim i As Integer
For i = 1 To colText.Count
colText.Remove 1
Next
Set colText = Nothing
End Sub
===== 標準モジュール(Module1) =====
Option Explicit
'「MyUserForm」は適宜変更
Sub ShowForm()
MyUserForm.Show
End Sub
Public Function 切り取り()
MyUserForm.ActiveControl.Cut
End Function
Public Function コピー()
MyUserForm.ActiveControl.Copy
End Function
Public Function 貼り付け()
MyUserForm.ActiveControl.Paste
End Function
===== クラスモジュール(cCopyPaste) =====
Option Explicit
'コピー＆ペースト用プロシージャのプロジェクト名とモジュール名。ここは適宜変更のこと。
Private Const Project As String = "myProject.Module1"
Public WithEvents Text As MSForms.TextBox
Public WithEvents Comb As MSForms.ComboBox
'ComboBoxがリスト表示している時はショートカットメニューを表示しないようにするため
Private flgDrop As Boolean
Private Sub Class_Terminate()
Set Text = Nothing
Set Comb = Nothing
End Sub
Private Sub Comb_DropButtonClick()
'リスト表示中はTrueとなる
flgDrop = Not flgDrop
End Sub
Private Sub Comb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If flgDrop Then Exit Sub 'リスト表示中は無効にする
MouseUp Button, Comb
End Sub
Private Sub Text_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MouseUp Button, Text
End Sub
Private Sub MouseUp(ByVal Button As Integer, Ctrl As MSForms.Control)
If Button <> 2 Then Exit Sub
Dim Cb As CommandBar
Dim Btn As CommandBarButton
Set Cb = Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True)
Set Btn = Cb.Controls.Add(Type:=msoControlButton)
With Btn
.Caption = "切り取り"
.OnAction = Project & ".切り取り"
'テキスト未選択時は無効にする
If Ctrl.SelText = "" Then
.Enabled = False
End If
End With
Set Btn = Cb.Controls.Add(Type:=msoControlButton)
With Btn
.Caption = "コピー"
.OnAction = Project & ".コピー"
'テキスト未選択時は無効にする
If Ctrl.SelText = "" Then
.Enabled = False
End If
End With
Set Btn = Cb.Controls.Add(Type:=msoControlButton)
With Btn
.Caption = "貼り付け"
.OnAction = Project & ".貼り付け"
'クリップボードに文字列が無い時は無効にする
If Not Ctrl.CanPaste Then
.Enabled = False
End If
End With
Cb.ShowPopup
Cb.Delete
End Sub
