| |
こんにちは。
全てのTextBoxに対応すべくクラスモジュールを使ってみました。
なお、メニューのボタンはイベントを使ってます。(2000以降限定かも？)
ユーザーフォームモジュール
--------------------------------------------------------------------------
Option Explicit
Private WithEvents CopyBtn As Office.CommandBarButton
Private WithEvents CutBtn As Office.CommandBarButton
Public WithEvents PasteBtn As Office.CommandBarButton
Public BarTmp As Office.CommandBar
Public TxtTmp As MSForms.TextBox
Private TxtBoxes() As TxtBoxCLs
Const BARNAME As String = "TXTMENU"
'コピーボタン
Private Sub CopyBtn_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
TxtTmp.Copy
PasteBtn.Enabled = TxtTmp.CanPaste
End Sub
'カットボタン
Private Sub CutBtn_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
TxtTmp.Cut
End Sub
'貼り付けボタン
Private Sub PasteBtn_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
TxtTmp.Paste
End Sub
Private Sub UserForm_Initialize()
Dim ContItem As MSForms.Control
Dim LngX As Long
For Each ContItem In Me.Controls
If TypeOf ContItem Is MSForms.TextBox Then
ReDim Preserve TxtBoxes(LngX)
Set TxtBoxes(LngX) = New TxtBoxCLs
Set TxtBoxes(LngX).Txt = ContItem
LngX = LngX + 1
End If
Next ContItem
Call BarDLt
Call BarAdd
End Sub
Private Sub UserForm_Terminate()
Erase TxtBoxes
Call BarDLt
Set TxtTmp = Nothing
Set BarTmp = Nothing
Set CutBtn = Nothing
Set CopyBtn = Nothing
Set PasteBtn = Nothing
End Sub
'メニュー削除
Private Sub BarDLt()
On Error Resume Next
Application.CommandBars(BARNAME).Delete
End Sub
'メニュー作成
Private Sub BarAdd()
Set BarTmp = Application.CommandBars.Add(BARNAME, msoBarPopup, , True)
With BarTmp
Set CutBtn = .Controls.Add(msoControlButton)
Set CopyBtn = .Controls.Add(msoControlButton)
Set PasteBtn = .Controls.Add(msoControlButton)
End With
CutBtn.Caption = "Cut(&T)"
CutBtn.FaceId = 21
CopyBtn.Caption = "Copy(&C)"
CopyBtn.FaceId = 19
PasteBtn.Caption = "Paste(&P)"
PasteBtn.FaceId = 22
End Sub
クラスモジュール(オブジェクト名TxtBoxCLs)
--------------------------------------------------------------------------
Option Explicit
Private WithEvents xTxt As MSForms.TextBox
Property Set Txt(ByVal TTmp As MSForms.TextBox)
Set xTxt = TTmp
End Property
'マウスアップイベント
Private Sub xTxt_MouseUp(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
With UserForms(0)
Set .TxtTmp = xTxt
.PasteBtn.Enabled = xTxt.CanPaste
.BarTmp.ShowPopup
End With
End If
End Sub
的はずれでしたらすいません。
|
|
- 04/2/29(日) 11:55 -
