エクセルVBAでセル範囲のデータをクリップボードに

Question

セル範囲のデータをテキストとしてクリップボードに取り込みたいのです。

http://oshiete.goo.ne.jp/qa/5650002.html#16327676　の回答ANo2を見て

Sub test01()
    Dim myData As DataObject
    Dim myCb As Variant
    Dim x
    x = "TESTデータです。"
    Set myData = New DataObject
    myData.SetText x
    myCb = myData.GetText
    myData.PutInClipboard
End Sub

は出来ました。
そこで、セル範囲A1:B3をクリップボードに貼ろうといろいろやってみました。
一応、下記でできましたが、実際にはもっと広い範囲を取り込みたいので、もっと簡単な方法はないでしょうか？

Sub Clip()
    Dim myStr As String
    Dim myData As DataObject
    Dim myCb As Variant
    Set myData = New DataObject
    With Sheets(1)
        myStr = .Range("A1").Value & ":" & .Range("B1").Value & _
        vbNewLine & .Range("A2").Value & ":" & .Range("B2").Value & _
        vbNewLine & .Range("A3").Value & ":" & .Range("B3").Value
    End With
    myData.SetText myStr ', 1
    myCb = myData.GetText
            
    If MsgBox("データ" & vbNewLine & myCb & " をクリップボードに送りますか？ ", vbYesNo + vbQuestion, "確認") = vbNo Then
        Exit Sub
    End If
    myData.PutInClipboard
End Sub

end-u · Accepted Answer

横いりすみません。

必要範囲をCoryしたら、
DataObjectのGetFromClipboardメソッドを使ってクリップボードデータを取得します。
そこからさらにDataObjectのGetTextメソッドを使うとテキスト文字列だけ取り出せます。
その後、DataObjectをClearして
あらためて取り出したテキスト文字列をSetTextすれば良いです。
各メソッドについては、DataObjectのヘルプを見て下さい。

ただし、OutlookならCtrl+VまでVBAでやれば良い気がしますが。
http://outlooklab.wordpress.com/
この辺りを参考にしてみると良いかと。
Sub try()
　　Const olFolderInbox As Long = 6
　　Const olMailItem As Long = 0
　　Dim obj As Object
　　Dim ins As Object
　　Dim m　 As Object
　　Dim tmp As String

If TypeName(Selection) <> "Range" Then Exit Sub

Selection.Copy
　　With New DataObject
　　　　.GetFromClipboard
　　　　tmp = .GetText
　　　　.Clear
　　End With
　　Application.CutCopyMode = False

On Error Resume Next
　　Set obj = GetObject(, "Outlook.Application")
　　On Error GoTo 0
　　If obj Is Nothing Then
　　　　Set obj = CreateObject("Outlook.Application")
　　　　obj.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Display
　　End If

For Each ins In obj.Inspectors
　　　　With ins.CurrentItem
　　　　　　If .MessageClass = "IPM.Note" Then
　　　　　　　　If Not .Sent Then
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　End If
　　　　End With
　　Next

If ins Is Nothing Then
　　　　Set m = obj.CreateItem(olMailItem)
　　Else
　　　　Set m = ins.CurrentItem
　　　　Set ins = Nothing
　　End If

m.body = tmp
　　m.Display

Set m = Nothing
　　Set obj = Nothing
End Sub

mitarashi · Answer

#3です。ちょっと悪のり？
xl2010の場合、クリップボードに何が収納されるか調べてみました。
当たり前ですが、XML形式が増えて、Lotus123の形式が無くなって、Bifも極端に古いのは無くなっておりますね。
そこから先の形式には差が無いようですが、どんなものかは存じません。ご参考まで。
なお、今回はxl2010でレタッチしてみました。トリミングが面倒！トーンカーブは無さそう．．．

mitarashi · Answer

#3です。何故か盛り上がっていますね。
一つ思いついてしまいました。UserFormに、テキストボックスと、コマンドボタンを一個置きます。
UserForm1をモードレスで表示させ、セルを選択してコマンドボタンを押すと、テキストボックスや、単独セル内に貼り付けられる形で文字列がクリップボードにコピーされますので、質問者様のなさりたい事が出来ているのではと思います。
UserForm1のコードは下記だけです。ご参考まで。

Private Sub CommandButton1_Click()
  Selection.Copy
  With Me.TextBox1
            .Paste
            .SetFocus
            .SelStart = 0
            .SelLength = Len(Me.TextBox1)
            .Copy
  End With
End Sub

Private Sub UserForm_Initialize()
  Me.TextBox1.MultiLine = True
End Sub

end-u · Answer

げっ
>必要範囲をCoryしたら、
必要範囲をCopyしたら、
..です...orz

nicotinism · Answer

こんな感じじゃ？

Sub てすと()
　　Dim rC As Long, rR As Long
　　Dim strT As String
　　Dim myStr As String
　　Dim myData As DataObject
　　'Dim myCb As Variant

Set myData = New DataObject

Range("A1:D10").Select 'か適当に選択しておいて

For rR = 1 To Selection.Rows.Count
　　　　For rC = 1 To Selection.Columns.Count
　　　　　　strT = strT & vbTab & Selection(1).Offset(rR - 1, rC - 1)
　　　　Next rC
　　　　strT = Mid(strT, 2)
　　　　myStr = myStr & vbCrLf & strT
　　　　strT = ""
　　Next rR
　　myStr = Mid(myStr, 3)

myData.SetText myStr ', 1
　　'myCb = myData.GetText

If MsgBox("データ" & vbNewLine & myStr & " をクリップボードに送りますか？ ", vbYesNo + vbQuestion, "確認") = vbNo Then
　　　　Exit Sub
　　End If
　　myData.PutInClipboard
End Sub

mitarashi · Answer

添付図はxl2000の例ですが、セルをクリップボードにコピーすると、ここに上がっている全ての形式で格納される事になります。
RangeObjectだけで貼り付けられる訳ではありません。テキストの他にも、画像形式とか色々ありますね。例えばBiff?というのは、2003までのエクセルネイティブなデータ構造です。
なお、２列表示の図にする際に、clipbrd.exeで表示できない、グレー表示されている形式の部分は見難いので少し濃い色に変えてあります。

さて本題ですが、Range("A1:C3").Copyを実行後に、テキストエディターに貼り付けると、TAB区切りで貼り付けられます。
emaxemax様が、Outlookに貼り付けるときに期待した姿にならないとすると、Outlook側の問題だと思います。

kybo · Answer

>AとB列のテキストをコロンで結んだのは、それしかやりようがなかったからそうしましたが、本当はTabキーを打ったようにしたいのです。

If C.Column = 1 Then 'C.Column = 1はＡ列の意味
myStr = myStr & vbNewLine & C.Value
Else
myStr = myStr & vbTab & C.Value
End If

と":"をvbTabにすればいいです。

>やはりループさせる方法しかないのでしょうか？

本当にあなたがしたいことが、どういうことなのかしりませんが、通常セルをコピーしてExcelのクリップボードに入れたいだけであれば、以下の1行で用が足せます。

Range("A1:B100").Copy

kybo · Answer

以下の様な感じでどうでしょうか

Sub Clip()
    Dim myStr As String
    Dim myData As DataObject
    Dim myCb As Variant
    Set myData = New DataObject
    Dim C As Range
    With Sheets(1)
        For Each C In .Range("A1:B100")
            If myStr = "" Then
                myStr = C.Value
            Else
                If C.Column = 1 Then 'C.Column = 1はＡ列の意味
                    myStr = myStr & vbNewLine & C.Value
                Else
                    myStr = myStr & ":" & C.Value
                End If
            End If
        Next C
    End With
    myData.SetText myStr ', 1
    myCb = myData.GetText
    If MsgBox("データ" & vbNewLine & myCb & " をクリップボードに送りますか？ ", vbYesNo + vbQuestion, "確認") = vbNo Then
        Exit Sub
    End If
    myData.PutInClipboard
End Sub

エクセルVBAでセル範囲のデータをクリップボードに

横いりすみません。

#3です。

#3です。

げっ

こんな感じじゃ？

添付図はxl2000の例ですが、セルをクリップボードにコピーすると、ここに上がっている全ての形式で格納される事になります。

この回答への補足

>AとB列のテキストをコロンで結んだのは、それしかやりようがなかったからそうしましたが、本当はTabキーを打ったようにしたいのです。

以下の様な感じでどうでしょうか

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング