「ブロック機能」のリニューアルについて

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

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

教えて!goo グレード

A 回答 (8件)

横いりすみません。



必要範囲を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
    • good
    • 0
この回答へのお礼

ほんとうにお世話になりました。
ありがとうございます。

お礼日時:2012/08/18 00:38

#3です。

ちょっと悪のり?
xl2010の場合、クリップボードに何が収納されるか調べてみました。
当たり前ですが、XML形式が増えて、Lotus123の形式が無くなって、Bifも極端に古いのは無くなっておりますね。
そこから先の形式には差が無いようですが、どんなものかは存じません。ご参考まで。
なお、今回はxl2010でレタッチしてみました。トリミングが面倒!トーンカーブは無さそう...
「エクセルVBAでセル範囲のデータをクリッ」の回答画像8
    • good
    • 0
この回答へのお礼

なんどもありがとうございます。
勉強します。

お礼日時:2012/08/14 16:08

#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
    • good
    • 0
この回答へのお礼

ありがとうございます。
勉強になります。

お礼日時:2012/08/14 16:07

げっ


>必要範囲をCoryしたら、
必要範囲をCopyしたら、
..です...orz
    • good
    • 0
この回答へのお礼

ありがとうございます。

お礼日時:2012/08/14 16:06

こんな感じじゃ?



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
    • good
    • 0
この回答へのお礼

ありがとうございます。
思った通りの動きです。
お礼が遅くなり、大変申し訳ございません。
いろいろなトラブルがあり、このサイトを見に来れませんでした。

お礼日時:2012/08/14 16:00

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


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

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

この回答への補足

すみません、ほかの回答へのお礼を間違えて書いてしまいました。

補足日時:2012/08/14 16:00
    • good
    • 0
この回答へのお礼

ありがとうございます。
思った通りの動きです。
お礼が遅くなり、大変申し訳ございません。
いろいろなトラブルがあり、このサイトを見に来れませんでした。

お礼日時:2012/08/14 15:58

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





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


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


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

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

Range("A1:B100").Copy
    • good
    • 0
この回答へのお礼

何度もありがとうございます。
やりたいことは、一番最初に書いたとおり、
セル範囲のデータをテキストとしてクリップボードに取り込みたいのです。

Range("A1:B100").Copy
では、テキストではなくRangeObjectが入ってしまいます。

Ctrl+VキーでOutlookメールの本文にテキストで貼り付けたいのです。

お礼日時:2012/07/30 15:02

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




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はA列の意味
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
    • good
    • 0
この回答へのお礼

さっそくありがとうございます。
やはりループさせる方法しかないのでしょうか?
あと、AとB列のテキストをコロンで結んだのは、それしかやりようがなかったからそうしましたが、本当はTabキーを打ったようにしたいのです。
わがまま言ってすみません。
よろしくお願いします。

お礼日時:2012/07/30 14:07

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

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

教えて!goo グレード

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

人気Q&Aランキング