[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コピーした文章をTextBoxの中に貼り付けたい』（草）
こんばんは Ctrl + V で貼り付け出来ますよ。 どうしても右クリックでという事でしたらポップアップメニューを自作する必要が有ります。 （ウッシ）
以前こんなコードを投稿したことがありました。
新規ブックにて試してみてください。
クラスモジュールを二つ作成してください（Class1とClass2）。
クラス名-----Class1
Class1のモジュールに
'========================================================
Option Explicit
Private WithEvents btnCopy As Office.CommandBarButton
Private WithEvents btnCut As Office.CommandBarButton
Private WithEvents btnPaste As Office.CommandBarButton
Private barM As Office.CommandBar
Private conttmp As MSForms.Control
Const Bnm As String = "ccpmenu"
Const Ctxt As String = "TextBox"
Const Clbl As String = "Label"
Private cpt() As class2
'==============================================================
Sub init()
'コピーペーストクラスの初期化 インスタンス作成後、
'必ず最初に実行する ファイルのOpenみたいなもの
On Error Resume Next
Application.CommandBars(Bnm).Delete
Set barM = Application.CommandBars.add(Bnm, msoBarPopup, , True)
With barM
Set btnCut = .Controls.add(msoControlButton)
btnCut.Style = msoButtonCaption
btnCut.Caption = "切り取り"
Set btnCopy = .Controls.add(msoControlButton)
btnCopy.Caption = "コピー"
btnCopy.Style = msoButtonCaption
Set btnPaste = .Controls.add(msoControlButton)
btnPaste.Caption = "貼り付け"
btnPaste.Style = msoButtonCaption
End With
End Sub
'==========================================================
Sub term()
'コピーペーストクラスの終了処理 ファイルのCloseみたいなもの
On Error Resume Next
Dim g0 As Long
For g0 = LBound(cpt()) To UBound(cpt())
Set cpt(g0) = Nothing
Next
Application.CommandBars(Bnm).Delete
On Error GoTo 0
End Sub
'====================================================
Sub add(ByVal Cobj As MSForms.Control)
'コピーペーストメニューを表示するコントロールを登録する
'いまところ、TextboxとLabelだけ
Dim g0 As Long
On Error Resume Next
g0 = UBound(cpt()) + 1
If Err.Number <> 0 Then g0 = 1
ReDim Preserve cpt(1 To g0)
Set cpt(g0) = New class2
If TypeName(Cobj) = Ctxt Then
Set cpt(g0).Txtev = Cobj
ElseIf TypeName(Cobj) = Clbl Then
Set cpt(g0).Lblev = Cobj
End If
Set cpt(g0).parent = Me
cpt(g0).id = g0
On Error GoTo 0
End Sub
'===========================================================
Sub callback(ByVal contP As MSForms.Control)
'右クリックでのメニュー表示
Set conttmp = contP
If TypeName(conttmp) = Ctxt Then
btnCut.Enabled = True
btnPaste.Enabled = conttmp.CanPaste
ElseIf TypeName(conttmp) = Clbl Then
btnCut.Enabled = False
btnPaste.Enabled = False
End If
barM.ShowPopup
End Sub
'====================================================================
Private Sub btnCopy_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'コピーが選択されたときの処理
If TypeName(conttmp) = Ctxt Then
conttmp.Copy
ElseIf TypeName(conttmp) = Clbl Then
Dim dobj As DataObject
Set dobj = New DataObject
If conttmp.Caption <> "" Then
Set dobj = New DataObject
dobj.SetText conttmp.Caption
dobj.PutInClipboard
Set dobj = Nothing
End If
End If
End Sub
'==============================================================
Private Sub btnCut_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'切り取りが選択されたときの処理
If TypeName(conttmp) = Ctxt Then
conttmp.Cut
End If
End Sub
'===============================================================
Private Sub btnPaste_Click( _
ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'貼付が選択されたときの処理
If TypeName(conttmp) = Ctxt Then
conttmp.Paste
End If
End Sub
クラス名---Class2
Class2のモジュールに
'=======================================================
Option Explicit
Public WithEvents Txtev As MSForms.TextBox
Public WithEvents Lblev As MSForms.Label
Public id As Long
Private cpo As Object
'===============================================================
Property Set parent(pcpo As Object)
Set cpo = pcpo
End Property
Private Sub Lblev_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
cpo.callback Lblev
End If
End Sub
'==========================================================
Private Sub Txtev_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 2 Then
cpo.callback Txtev
End If
End Sub
これでクラスモジュールの準備はＯＫ
次にユーザーフォームを一つ作成してください（UserForm１）。
UserForm1に テキストボックスを二つ作成してください。 TextBox1 、 TextBox2
このUserForm1のモジュ-ルに
'===========================================================
Option Explicit
Private ccpmenu As class1
Private Sub UserForm_Initialize()
Set ccpmenu = New class1
ccpmenu.init
ccpmenu.add TextBox1
ccpmenu.add TextBox2
End Sub
'==========================================================
Private Sub UserForm_Terminate()
ccpmenu.term
Set ccpmenu = Nothing
End Sub
最後に標準モジュールに
Option Explicit
Sub main()
UserForm1.Show vbModeless
End Sub
コ-ドは以上です。
mainを実行して、各テキストボックスにて右クリックでメニューが表示されることを 確認して、実際にコピー&ペーストを行ってみてください。
研究して、これにコンボボックスでもメニュー表示が可能になるように 機能追加してみてください。
ichinose
質問者ではないのに良いコードを見られてホクホクです。
なるほど・・・・貼り付けだけなら～と
オブジェクトモジュール
Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) If Button < 2 Then Exit Sub Set myControl = Me.TextBox1 MakePopup End Sub
標準モジュール
Option Private Module
Public myControl As Object
Sub MakePopup()
On Error Resume Next
Application.CommandBars("myOriginal").Delete
On Error GoTo 0
With Application.CommandBars.Add("myOriginal", msoBarPopup)
With .Controls.Add(msoControlButton)
.Caption = "貼り付け"
.OnAction = "myPaste"
End With
.ShowPopup
.Delete
End With
End Sub
Sub myPaste() myControl.Paste End Sub
なんて事を考えつつも、CopyとCutどうやって実装しようかな～と悩んでました。 DataObjectでPutInClipboardという案までは思いついたんですが、そこから先に行けず。 クラスモジュールにすればいいんだな～と、とても納得しました。 良い勉強になりました。ichinoseさんありがとうございます。
これ、参照設定必要ですよね？ あ・・・UserForm作ってるからしなくてもいいか・・・
（ｍｏｍｏ）
>これ、参照設定必要ですよね？ DataObjectへのそれですよね？ 投稿したコ-ド自体には要りません・・・、ね！！
今回は、一例として動作だけ確認してもらえばよい という考えで ユーザーフォームと クラスモジュールが同じプロジェクトにあるという 前提のコードで投稿しましたが、 私の実際の運用では、クラスモジュールとそれ以外のコードは 別プロジェクト（別のブック）にしています。
クラスモジュールは、アドインブックとして、他のユーザーフォームでも利用可能に しておきます。 この場合、ｍｏｍｏさんご指摘のDataObjectへの参照設定は、必要になってきますね！！
実際の運用では、Class1のモジュールのInstancingというプロパティを PublicNotCreatable（２）に設定し、クラスモジュールを含んだ プロジェクト側でClass1のIntanceを作成するFunction関数を作っておきます。
このように作成して、ユーザーフォームのあるブック側では、 このクラスモジュールを含んだアドインを参照設定して、運用しています。
よって、プログラマは、Class1のメソッドさえ知っていれば、 コピー&ペーストのメニュー画面がどのユーザーフォームでも表示できますよね？
こういう部品を一つでも多く作っておいて、私の仕事では楽をしたい というのがこういう掲示板に参加する理由の一つです。
ichinose
質問者さんに場所をお借りしたままですみません。 レスが無いようですが解決できると良いですね。
ichinoseさん 普段ですと１つのプロジェクトで済んでしまいますが カプセル化というかパーツ化は最近よく考えています。 とは言ってもモジュールレベルで用途によって呼び出すだけですが・・・
>クラスモジュールを含んだプロジェクト側でClass1のIntanceを作成するFunction関数を作っておきます。
なるほど、これは簡単なのに思いつきませんでした。 私も独学の限界を超えてみたかったのでこのような掲示板で得られる事がとても有意義です♪ いつもありがとうございます。 （ｍｏｍｏ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.