Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


70080 / 76734 ←次へ | 前へ→

【11165】Re:text boxについて
質問  NH  - 04/3/1(月) 20:32 -

引用なし
パスワード
   ▼Jカーター さん:
>こんにちは。
>全ての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
>
>的はずれでしたらすいません。


回答していただいた長文に対して失礼なんですが、解説していただけない
でしょうか(^^;。
1 hits

【11101】text boxについて NH 04/2/28(土) 10:03 質問
【11102】Re:text boxについて ichinose 04/2/28(土) 10:10 回答
【11126】Re:text boxについて NH 04/2/28(土) 21:10 質問
【11132】Re:text boxについて IROC 04/2/29(日) 1:11 回答
【11138】Re:text boxについて クウガ 04/2/29(日) 11:55 発言
【11140】Re:text boxについて ichinose 04/2/29(日) 12:07 発言
【11147】Re:text boxについて Jカーター 04/3/1(月) 13:10 回答
【11149】Re:text boxについて Jカーター 04/3/1(月) 13:15 回答
【11165】Re:text boxについて NH 04/3/1(月) 20:32 質問
【11169】Re:text boxについて Jカーター 04/3/2(火) 9:29 回答
【11178】Re:text boxについて IROC 04/3/2(火) 11:43 回答
【11214】Re:text boxについて NH 04/3/2(火) 18:23 お礼

70080 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free