ExcelVBA技
ユーザーフォーム
E13U014
E13U014 (Excel2000~2013)
ユーザーフォームのテキストボックスにコピー&貼り付け等の右クリックショトカットメニューを付加する
ユーザーフォームのテキストボックスにコピー&貼り付け等の右クリックショトカットメニューを付加するクラス[CRightClick] をご紹介します。
対応コントロール:[テキストボックス]、[コンボボックス]
メニュー項目 :[切り取り]、[コピー]、[貼り付け]、[削除]、[すべて選択]
使い方は非常に簡単で、CRightClickクラスのインスタンスを作成し Initializeメソッドを呼ぶだけです。
'フォーム モジュール Option Explicit 'クラスモジュール CRightClick の使用例 Private Sub UserForm_Initialize() Static dcp As New CRightClick dcp.Initialize Me End Sub
'CRightClick クラスモジュール Option Explicit Public WithEvents Tb As MSForms.TextBox Public WithEvents Cb As MSForms.ComboBox Private WithEvents BCut As Office.CommandBarButton Private WithEvents BCopy As Office.CommandBarButton Private WithEvents BPaste As Office.CommandBarButton Private WithEvents BDelete As Office.CommandBarButton Private WithEvents BAll As Office.CommandBarButton Dim dbox As Collection Private Sub BAll_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) Dim bx As Object If TypeName(Tb) = "TextBox" Then Set bx = Tb Else Set bx = Cb With bx .SelStart = 0 .SelLength = Len(.Value) End With End Sub Private Sub BCopy_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) If TypeName(Tb) = "TextBox" Then Tb.Copy Else Cb.Copy End Sub Private Sub BCut_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) If TypeName(Tb) = "TextBox" Then Tb.Cut Else Cb.Cut End Sub Private Sub BDelete_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) If TypeName(Tb) = "TextBox" Then Tb.SelText = "" Else Cb.SelText = "" End Sub Private Sub BPaste_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean) If TypeName(Tb) = "TextBox" Then Tb.Paste Else Cb.Paste End Sub Private Sub Cb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _ ByVal X As Single, ByVal Y As Single) If Button = 2 And Cb.Style = fmStyleDropDownCombo Then pCopyPaste Cb End Sub Private Sub Tb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _ ByVal X As Single, ByVal Y As Single) If Button = 2 Then pCopyPaste Tb End Sub Sub Initialize(fm As Object) Dim cc As CRightClick, bx As Object On Error Resume Next Set dbox = New Collection For Each bx In fm.Controls Select Case TypeName(bx) Case "TextBox", "ComboBox" Set cc = New CRightClick If TypeName(bx) = "TextBox" Then Set cc.Tb = bx Else Set cc.Cb = bx dbox.Add cc End Select Next End Sub Private Sub pCopyPaste(bx As Object) 'Copy&Paste右クリックメニュー With Application.CommandBars.Add(Position:=msoBarPopup, Temporary:=True) Set BCut = .Controls.Add(msoControlButton) With BCut .Caption = "切り取り(&T)" .FaceId = 21 .Enabled = bx.SelLength If bx.Locked Then .Enabled = False End With Set BCopy = .Controls.Add(msoControlButton) With BCopy .Caption = "コピー(&C)" .FaceId = 19 .Enabled = bx.SelLength End With Set BPaste = .Controls.Add(msoControlButton) With BPaste .Caption = "貼り付け(&P)" .FaceId = 22 .Enabled = bx.CanPaste End With Set BDelete = .Controls.Add(msoControlButton) With BDelete .Caption = "削除(&D)" .FaceId = 47 .Enabled = bx.SelLength .BeginGroup = True End With Set BAll = .Controls.Add(msoControlButton) With BAll .Caption = "すべて選択(&A)" .Enabled = Len(bx.Value) End With .ShowPopup .Delete End With End Sub