| |
▼Ｊカーター さん：
>こんにちは。
>全ての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/3/1(月) 20:32 -
