[[20080222162057]]　『ユーザーフォーム上でのコピー貼り付け』（ひで）　ページの最後に飛ぶ

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

　

『ユーザーフォーム上でのコピー貼り付け』（ひで）

 ユーザーフォーム上にラベル枠を貼り付けて
 文字を表示しています。
 ここに表示されている文字をコピーし
 同一のフォーム上のテキストボックスに貼り付ける事って
 可能でしょうか。もしできるとしたら
 どのように設定すればよいのでしょうか。
 また，テキストボックス上の文字も範囲設定はできるのですが，
　コピーできません。これも可能かどうか教えてください。

 よろしくお願いいたします。

---

 LabelはCaption
 でTextBoxはValue
 ですね。

 >テキストボックス上の文字も範囲設定はできるのですが，
 >コピーできません。

 Ctrl + C
 でコピーできます。
 貼付けは、
 Ctrl + V
 です。
 (MARBIN)

---

ありがとうございます。キーボードではできるんですね。
マウスでは無理ですか？

＞LabelはCaption

 でTextBoxはValue
 ですね。

そういう設定になっています。
ラベル上ではやはりキーボード，マウスともに無理でしょうか。
（ひで）

---

 >LabelはCaption
 >でTextBoxはValue
 >ですね。

 これはVBAで転記する場合です。
 Me.TextBox1.Value = me.Label1.Caption

 >ラベル上ではやはりキーボード，マウスともに無理でしょうか。
 無理だと思います。
 むしろ、ユーザーに操作させたくないときにLabelが好んで使われます。
 (MARBIN)

---

*　　ラベル上ではやはりキーボード，マウスともに無理でしょうか。

私も無理だとは、思いますが、無理に作れば　可能ですよ！！
（但し、ラベルのドラッグは出来ませんが）

こんな例で考えます。

　ユーザーフォーム上にラベルをひとつ、

　テキストボックスを二つ、コマンドボタンをひとつ

　配置したものを作ります。

コマンドボタンのクリックでひとつのテキストボックスの内容をラベルに表示する

機能としては、これだけのユーザーフォームです。

新規ブックに　ユーザーフォームを作成します

　　ユーザーフォーム（UserForm1）

　　　　　ラベル1　　　　　　ラベル　という見出し

　　　　　ラベル2　　　　　　テキストボックスの内容を表示する

　　　　　ラベル3　　　　　　テキストという見出し

　　　　　テキストボックス1　ラベルに表示する内容を入力する

　　　　　ラベル4　　　　　　テキストという見出し

　　　　　テキストボックス2　ラベル2の内容を貼り付けるために使用

　　　　　コマンドボタン　　 テキストボックス1の内容をラベル2に表示

こんなユーザーフォームを作成します。

このユーザーフォームの中で　ラベル2とテキストボックス2に関して、

マウスでコピー&ペースト（カット&ペースト）の実現を考えます。

（但し、ラベルは、コピーだけ）

本来なら、これらは事前にコントロールを配置すれば簡単ですが、

同期をとるためにコントロールの配置はコードで行います。
　　　　　

では、コードです。

新規ブックにユーザーフォーム（UserForm1）だけ作成してください。

コントロールは、コードで作成しますから、何も配置しないで下さい。

このUserForm1のモジュールに

'============================================================================

Option Explicit

Private lbl As MSForms.Label

Private txt1 As MSForms.TextBox

Private txt2 As MSForms.TextBox

Private WithEvents btn As MSForms.CommandButton

Private Class_ccp As Class1

Private Sub btn_Click()

    lbl.Caption = txt1.Text
End Sub

Private Sub UserForm_Initialize()

'****************************************************************

    With Me
       .Width = 316
       .Height = 220
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 24
          .Width = 60
          .Height = 18
          .Caption = "ラベル"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set lbl = .Controls.add("Forms.Label.1", , True)
       With lbl
          .Left = 71.95
          .Top = 24
          .Width = 222
          .Height = 18
          .Caption = ""
          .BackColor = &HFFFFC0
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 60
          .Width = 60
          .Height = 18
          .Caption = "テキスト1"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set txt1 = .Controls.add("Forms.TextBox.1", , True)
       With txt1
          .Left = 71.95
          .Top = 60
          .Width = 222
          .Height = 18
          .Font.Size = 12
          End With
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 96
          .Width = 60
          .Height = 18
          .Caption = "テキスト2"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set txt2 = .Controls.add("Forms.TextBox.1", , True)
       With txt2
          .Left = 71.95
          .Top = 96
          .Width = 222
          .Height = 18
          .Font.Size = 12
          End With
       Set btn = .Controls.add("Forms.CommandButton.1", , True)
       With btn
          .Left = 168
          .Top = 132
          .Width = 126
          .Height = 42
          .Caption = "テキスト---＞ラベル"
          End With
       End With
'*********   ここまでは、本来は、事前にコントロールを配置すれば、要らないコードです
    Set Class_ccp = New Class1
    With Class_ccp
       .init
       .add lbl
       .add txt2
       End With
End Sub

Private Sub UserForm_Terminate()

    Class_ccp.term
End Sub

次にコピー&ペーストを実現するクラスモジュールを二つ作ります。

一つ目のクラスモジュール　クラス名　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()

    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()
    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)
    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
       dobj.SetText conttmp.Caption
       dobj.PutInClipboard
       Set dobj = Nothing
       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

'=================================================================================

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

最後に標準モジュールに

'=========================================================================

Option Explicit

Sub main()

    UserForm1.Show
End Sub

標準モジュールは、これだけ・・・。

　mainを実行してみてください。

　・ユーザーフォームが表示されます。

　・テキスト１に何か入力して　コマンドボタンをクリックしてください。

　・入力内容がラベルに表示されます。

　・入力内容が表示されたラベルにマウスをポイントし、右クリックしてください。

　・コピーのメニュー（ラベルの場合は、コピーのみ可）が表示されます。

　　「コピー」をクリックしてください

　・テキスト2をマウスでポイントし、右クリックしてください。

　　同じメニューが表示されます（今度は、３機能全部　可）。

　　ペーストをクリックすると、テキスト2にラベルの内容が表示されます。

上記のコードでは、表示ラベルとテキスト2のみ「コピー＆ペーストメニュー」を表示するように
設定してあります。

うまくいくようでしたら

コードを理解して、テキスト1でも「コピー＆ペーストメニュー」が表示されるように
設定してみてください。

この改良自体は　コードが理解できれば簡単です。

また、クラスモジュールにしてありますから、

再利用が簡単に出来るようになっています。

ichinose

---

追伸

本来は、この二つのクラスモジュールは、別プロジェクトに保存して（アドインファイル）

、これを参照設定して使います。

そうしておくと、Class1とClass2の中身が隠蔽でき、

ユーザーは、インターフェースだけ知っていれば利用できますよね！！

ichinose

---

 ichinoseさん、すばらしいコードですね。やりたいことはほとんどこれなんです。
 尊敬に値します。

 ただ、すでに作ってしまったるユーザーフォーム上のラベル(ラベル88)に表示されてい る文字列を
 何とか範囲選択してコピーできるようにしたかったのです。

 そして同一フォーム上にあるテキストボックス(テキストボックス３１，３２，３３，
 ３４＝4つです）に貼り付けられればいいと思いました。貼り付けるテキストボックスは任意で貼り付けたいテキストボックス上で右クリックなどでできないかと思ったのです。

 ichinoseさんの作成していただいたコードを変更するのは
 今の初心者である今の私には難解です。

 ありがとうございます。時間はかかるかもしれませんが、理解できるようにがんばりま す。
 もし、これからも教えていただけるのならよろしくお願いいたします。(ひで）

---

 **　すでに作ってしまったるユーザーフォーム上のラベル(ラベル88)に表示されてい る文字列を
 何とか範囲選択してコピーできるようにしたかったのです。

これは、コントロールがラベルだと私には、方法が見つかりません。

 代替案として、このラベル88もテキストボックスに変えてしまうという案はいかがですか？
 前回、私が提示したコードのラベル2をラベルでなく、テキストボックスにするということです。

 テキストボックスでも入力不可にすることはできますからねえ・・・。

 ラベルをテキストボックスに変えただけのコードを提示しますから、検討してみてください。
 尚、クラスモジュールに訂正もありましたから、併せて投稿します。

 前回同様、新規ブックにユーザーフォーム（UserForm1）だけ作成してください。
 UserForm1のモジュールに

 '===================================================================================
 Option Explicit
 Private txt_lbl As MSForms.TextBox
 Private txt1 As MSForms.TextBox
 Private txt2 As MSForms.TextBox
 Private WithEvents btn As MSForms.CommandButton
 Private Class_ccp As Class1
 Private Sub btn_Click()
    txt_lbl.Text = txt1.Text
 End Sub
 Private Sub UserForm_Initialize()
 '****************************************************************
    With Me
       .Width = 316
       .Height = 220
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 24
          .Width = 60
          .Height = 18
          .Caption = "ラベル"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set txt_lbl = .Controls.add("Forms.TextBox.1", , True)
       With txt_lbl
          .Left = 71.95
          .Top = 24
          .Width = 222
          .Height = 18
          .Text = ""
          .BackColor = &HFFFFC0
          .Font.Size = 12
          .SpecialEffect = 2
          .Locked = True
          .TabStop = False
          End With
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 60
          .Width = 60
          .Height = 18
          .Caption = "テキスト1"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set txt1 = .Controls.add("Forms.TextBox.1", , True)
       With txt1
          .Left = 71.95
          .Top = 60
          .Width = 222
          .Height = 18
          .Font.Size = 12
          End With
       With .Controls.add("Forms.Label.1", , True)
          .Left = 12
          .Top = 96
          .Width = 60
          .Height = 18
          .Caption = "テキスト2"
          .BackColor = &HC0FFFF
          .Font.Size = 14
          .SpecialEffect = 2
          End With
       Set txt2 = .Controls.add("Forms.TextBox.1", , True)
       With txt2
          .Left = 71.95
          .Top = 96
          .Width = 222
          .Height = 18
          .Font.Size = 12
          End With
       Set btn = .Controls.add("Forms.CommandButton.1", , True)
       With btn
          .Left = 168
          .Top = 132
          .Width = 126
          .Height = 42
          .Caption = "テキスト---＞ラベル"
          End With
       End With
 '*********   ここまでは、本来は、事前にコントロールを配置すれば、要らないコードです
    Set Class_ccp = New Class1
    With Class_ccp
       .init
       .add txt_lbl
       .add txt2
       End With
 End Sub
 Private Sub UserForm_Terminate()

    Class_ccp.term
 End Sub

 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()
    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()
    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)
    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 = Not conttmp.Locked
       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
       If conttmp.Caption <> "" Then
          Dim dobj As DataObject
          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のモジュール

 '===============================================================================
 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

最後に

標準モジュールに

 '=====================================================================
 Option Explicit
 Sub main()
    UserForm1.Show
 End Sub

　これで　mainを実行して、前回と同様な処理を行ってみてください。

　今度は、文字列の選択が出来るでしょう！！
　これで代替できませんか？

---

コメント返信：

---

[ 一覧(最新更新順) ]

---

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