Excel VBA質問箱 IV

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

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


12307 / 13645 ツリー ←次へ | 前へ→

【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 お礼

【11101】text boxについて
質問  NH  - 04/2/28(土) 10:03 -

引用なし
パスワード
   マウスを右クリックしてクリップボードの中身を貼り付けたりしますよね。
それをテクストボックスに対して行いたいのですが、どのようにすればよろ
しいのでしょうか?

【11102】Re:text boxについて
回答  ichinose  - 04/2/28(土) 10:10 -

引用なし
パスワード
   ▼NH さん:
おはようございます。

>マウスを右クリックしてクリップボードの中身を貼り付けたりしますよね。
>それをテクストボックスに対して行いたいのですが、どのようにすればよろ
>しいのでしょうか?
V3にありました。

http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=one;no=12178;id=Excel

が参考になりませんか?

【11126】Re:text boxについて
質問  NH  - 04/2/28(土) 21:10 -

引用なし
パスワード
   ▼ichinose さん:
>V3にありました。
>
>http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=one;no=12178;id=Excel
>
>が参考になりませんか?

すんません、はっきり言って判りません(/_;)。
MouseMoveイベントで記述するのは判るんですが。ヘルプを見て
GetFromClipboard メソッドやxlClipboardFormatText等関係あるような
所は見たのですが、そこらへんからどうやって組み立てるのやら(^^;。
お教え願えないでしょうか。

【11132】Re:text boxについて
回答  IROC  - 04/2/29(日) 1:11 -

引用なし
パスワード
   ヘルプのCOPYメソッドの使用例ですが、もう読まれましたか?


Private Sub CommandButton1_Click()
  'クリップボードにコピーする前にテキストを選択する必要があります。
  TextBox1.SelStart = 0
  TextBox1.SelLength = TextBox1.TextLength
  TextBox1.Copy

  MyData.GetFromClipboard
  TextBox2.Text = MyData.GetText(1)
End Sub

【11138】Re:text boxについて
発言  クウガ E-MAILWEB  - 04/2/29(日) 11:55 -

引用なし
パスワード
   皆さん、こんにちは。
ご質問とは、ちょっとはなれていますが、
TakeFocusOnClickをFalseにした、
コピーボタン、貼り付けボタンを作っておき、

Private Sub コピーボタン_Click()
On Error Resume Next
  ActiveControl.Copy
End Sub

Private Sub 貼り付けボタン_Click()
On Error Resume Next
  ActiveControl.Paste
End Sub

と、いうのも有りでしょうか?
Frameの中にあるTextBoxには、
Frame1.ActiveControl.Paste
にしたりとか、ご参考になればよいのですが・・・

【11140】Re:text boxについて
発言  ichinose  - 04/2/29(日) 12:07 -

引用なし
パスワード
   ▼NH さん:
こんにちは。
>>V3にありました。
>>
>>http://www21.tok2.com/home/vbalab/bbs/c-board.cgi?cmd=one;no=12178;id=Excel
>>
>>が参考になりませんか?
>
>すんません、はっきり言って判りません(/_;)。
>MouseMoveイベントで記述するのは判るんですが。ヘルプを見て
>GetFromClipboard メソッドやxlClipboardFormatText等関係あるような
>所は見たのですが、そこらへんからどうやって組み立てるのやら(^^;。
>お教え願えないでしょうか。
ごめんなさい、他のリンクを調べたら全部リンク切れしているみたいでした。
私も自分で保存しておかなかったので詳細を記載する事ができません。
これは、ご本人の登場を待ってみましょう!!

【11147】Re:text boxについて
回答  Jカーター  - 04/3/1(月) 13:10 -

引用なし
パスワード
   こんにちは。
全ての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

的はずれでしたらすいません。

【11149】Re:text boxについて
回答  Jカーター  - 04/3/1(月) 13:15 -

引用なし
パスワード
   すいません
ここを変更して下さい。
----------------------------------------------------------------------
'コピーボタン
Private Sub CopyBtn_Click( _
  ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
  TxtTmp.Copy
  PasteBtn.Enabled = TxtTmp.CanPaste'★←不要でした m(_ _)m
End Sub

【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
>
>的はずれでしたらすいません。


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

【11169】Re:text boxについて
回答  Jカーター  - 04/3/2(火) 9:29 -

引用なし
パスワード
   こんにちは。
解説といっても苦手なのですが・・・

まず
クラスモジュールの使用理由

テキストボックスが10個あるとして
全てに同じMouseUpイベントを記述しなければなりません。
そこで
クラスモジュールを利用すると
クラスモジュール内に一個イベントを書くだけですみます。

それをふまえて
ユーザーフォームのInitializeイベントで行っていることは
1,クラスモジュールのインスタンスをテキストボックスの数分作成
2,ポップアップメニューの作成
です。

>Set TxtBoxes(LngX) = New TxtBoxCLs
でクラスのインスタンスが一個できます。
そのTxtプロパティにTextBoxを設定すると
クラスモジュールに書かれたイベントが使えるようになります。

プップアップメニュー作成は
まずメニューバーを作って
そこにカット、コピー、ペーストのボタンを乗っけます。
ここで乗っけたボタンを
>Private WithEvents CopyBtn As Office.CommandBarButton
>Private WithEvents CutBtn As Office.CommandBarButton
>Public WithEvents PasteBtn As Office.CommandBarButton
とWithEventsキーワードをくっつけて宣言しておくと
イベントプロシージャが使えるようになります。

コピーボタン、カットボタン、貼り付けボタン
とコメントがあるプロシージャがそれです。

実行される手順

TextBoxの上で右クリック
クラス内のMouseUpイベントイベント起動
ユーザーフォームモジュールに対象TextBoxを渡しておいて
そのテキストボックスのCanPasteプロパティにより
貼り付けボタンのEnabledを設定
メニュー出現

メニューの操作は各ボタンのイベントが担当
(渡されたTextBoxを対象に)

ユーザーフォームモジュールを閉じるときに
メニューの削除と
各変数の初期化を実行


という感じです。


※意味がわからないところはヘルプを調べて下さい。

【11178】Re:text boxについて
回答  IROC  - 04/3/2(火) 11:43 -

引用なし
パスワード
   私が勘違いしているのか、相手にされていないようですが・・・


Dim MyData As DataObject

Private Sub CommandButton1_Click()
Set MyData = New DataObject

  TextBox1.SelStart = 0
  TextBox1.SelLength = TextBox1.TextLength
  TextBox1.Copy
  
End Sub

Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  
  If Button = 2 Then
    MyData.GetFromClipboard
    TextBox2.Text = MyData.GetText(1)
  End If
  
End Sub

【11214】Re:text boxについて
お礼  NH  - 04/3/2(火) 18:23 -

引用なし
パスワード
   ▼IROC さん:
>私が勘違いしているのか、相手にされていないようですが・・・
>
>
>Dim MyData As DataObject
>
>Private Sub CommandButton1_Click()
>Set MyData = New DataObject
>
>  TextBox1.SelStart = 0
>  TextBox1.SelLength = TextBox1.TextLength
>  TextBox1.Copy
>  
>End Sub
>
>Private Sub TextBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
>  
>  If Button = 2 Then
>    MyData.GetFromClipboard
>    TextBox2.Text = MyData.GetText(1)
>  End If
>  
>End Sub

え〜と、気分を害された事、最初に謝っておきます。相手にしていないなんて
とんでもなく、皆さんに提示していただいたものを扱いかねているのが現状で
す。現状では今しばらく時間がかかりそうなんで、これはこれでおいておきた
いのですが。
 せっかく教えていただきながら、それを活かしきれないこと、
ichinoseさん、IROCさん、クウガさん、Jカーターさんに申し訳ないです。
 

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