[[20100921183617]] 『コピーした文章をTextBoxの中に貼り付けたい』(草) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『コピーした文章をTextBoxの中に貼り付けたい』(草)
コピーした文章をTextBox内に貼り付けれるようにしたいのですが、可能でしょうか?
今のところTextBox内で右クリックしてもメニューバーも何も出てこない状態です。
わかる方いらっしゃいましたら教えてください。
(Excel2007 Windows7)

 こんばんは
 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

 これでクラスモジュールの準備はOK

 次にユーザーフォームを一つ作成してください(UserForm1)。

 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作ってるからしなくてもいいか・・・

 (momo)

 >これ、参照設定必要ですよね?
 DataObjectへのそれですよね?
 投稿したコ-ド自体には要りません・・・、ね!!

 今回は、一例として動作だけ確認してもらえばよい という考えで
 ユーザーフォームと クラスモジュールが同じプロジェクトにあるという
 前提のコードで投稿しましたが、
 私の実際の運用では、クラスモジュールとそれ以外のコードは
 別プロジェクト(別のブック)にしています。

 クラスモジュールは、アドインブックとして、他のユーザーフォームでも利用可能に
 しておきます。
 この場合、momoさんご指摘のDataObjectへの参照設定は、必要になってきますね!! 

 実際の運用では、Class1のモジュールのInstancingというプロパティを
 PublicNotCreatable(2)に設定し、クラスモジュールを含んだ
 プロジェクト側でClass1のIntanceを作成するFunction関数を作っておきます。

 このように作成して、ユーザーフォームのあるブック側では、
 このクラスモジュールを含んだアドインを参照設定して、運用しています。

 よって、プログラマは、Class1のメソッドさえ知っていれば、
 コピー&ペーストのメニュー画面がどのユーザーフォームでも表示できますよね?

 こういう部品を一つでも多く作っておいて、私の仕事では楽をしたい
 というのがこういう掲示板に参加する理由の一つです。

 ichinose
 

 質問者さんに場所をお借りしたままですみません。
 レスが無いようですが解決できると良いですね。

 ichinoseさん
 普段ですと1つのプロジェクトで済んでしまいますが
 カプセル化というかパーツ化は最近よく考えています。
 とは言ってもモジュールレベルで用途によって呼び出すだけですが・・・

 >クラスモジュールを含んだプロジェクト側でClass1のIntanceを作成するFunction関数を作っておきます。

 なるほど、これは簡単なのに思いつきませんでした。
 私も独学の限界を超えてみたかったのでこのような掲示板で得られる事がとても有意義です♪
 いつもありがとうございます。
 (momo)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.