クリップボードの内容(数値もしくは文字列)を貼り付ける際、
アクティブなセルに値もしくはUnicodeテキストとして
貼り付けるコードを書こうとしています。
コピー&ペーストする内容は1つのセルだったり、複数のセル範囲だったり、
はたまたExcel以外のアプリケーションからのコピーだったりします。
それぞれについては下記のように書けば希望通りになるのですが
どちらであっても対応できるよう、
両方の機能を一つのプロシージャでまとめることは可能でしょうか?
■エクセルシート上の値(セルや範囲)からの貼り付け
Selection.PasteSpecial Paste:=xlValues
■外部ファイル(HTMLなど)からのUnicodeテキスト貼り付け
ActiveSheet.PasteSpecial Format:="Unicode テキスト"
これらは「マクロの記録」を参考にしたものですが、
Rangeオブジェクト用とWorksheetオブジェクト用に分かれているので
クリップボードの種別判定?やエラー判定?のようなif文等による
何らかの分岐が必要なのかなと思い、自分なりに調べてみましたが、
具体的な方法がわからず困っております。
どちらにも対応できるコードにするにはどうすれば良いでしょうか?
どうぞよろしくお願いいたします。
No.1
- 回答日時:
エクセルVBAのヘルプのコード(ちょっとアレンジ)ですが、これでクリップボードの中味を調べるのはいかがでしょうか。
Sub test()
Dim aFmts ,fmt
aFmts = Application.ClipboardFormats
For Each fmt In aFmts
Debug.Print fmt
Next fmt
End Sub
得られた数値は、下記と見比べてください(これもヘルプから)。試しにエクセルのセル群を
コピーしてみた結果ではこれでも全部の種類はカバーできていない様でした。xl2000の例です。
Sub test2()
Debug.Print xlClipboardFormatBIFF
Debug.Print xlClipboardFormatBIFF2
Debug.Print xlClipboardFormatBIFF3
Debug.Print xlClipboardFormatBIFF4
Debug.Print xlClipboardFormatBinary
Debug.Print xlClipboardFormatBitmap
Debug.Print xlClipboardFormatCGM
Debug.Print xlClipboardFormatCSV
Debug.Print xlClipboardFormatDIF
Debug.Print xlClipboardFormatDspText
Debug.Print xlClipboardFormatEmbeddedObject
Debug.Print xlClipboardFormatEmbedSource
Debug.Print xlClipboardFormatLink
Debug.Print xlClipboardFormatLinkSource
Debug.Print xlClipboardFormatLinkSourceDesc
Debug.Print xlClipboardFormatMovie
Debug.Print xlClipboardFormatNative
Debug.Print xlClipboardFormatObjectDesc
Debug.Print xlClipboardFormatObjectLink
Debug.Print xlClipboardFormatOwnerLink
Debug.Print xlClipboardFormatPICT
Debug.Print xlClipboardFormatPrintPICT
Debug.Print xlClipboardFormatRTF
Debug.Print xlClipboardFormatScreenPICT
Debug.Print xlClipboardFormatStandardFont
Debug.Print xlClipboardFormatStandardScale
Debug.Print xlClipboardFormatSYLK
Debug.Print xlClipboardFormatTable
Debug.Print xlClipboardFormatText
Debug.Print xlClipboardFormatToolFace
Debug.Print xlClipboardFormatToolFacePICT
Debug.Print xlClipboardFormatVALU
Debug.Print xlClipboardFormatWK1
End Sub
WindowsXPなら、下記も参考になります。
http://www.atmarkit.co.jp/fwin2k/win2ktips/103cl …
この回答への補足
とりあえず対処療法的に下記のようにしましたが、
希望動作はしてくれるものの自信は全くありません。
よろしければアドバイスをお願いいたします・・・。
(ちなみにOn Errorステートメントを使用しない場合、エラーコードは1004です。)
Sub Value_Paste()
' Value_Paste Macro
' 値・テキストのみの貼り付け
On Error GoTo WSObj
'Excelからのコピーにのみ有効(Rangeオブジェクト用)
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Exit Sub
WSObj:
'Excel以外からのコピーにのみ有効 (Worksheetオブジェクト用)
ActiveSheet.PasteSpecial Format:="Unicode テキスト"
End Sub
ご回答ありがとうございます。
ClipboardFormatsによる配列はこうやって調べられるんですね。
勉強になります。ただ、実はこれでイミディエイトに表示される値が
セルをコピーした状態(セルが点線点滅)だと「-1」一行のみなのですが
これはつまりクリップボードの中身が空?ということなのでしょうか。
また、試しにこのブラウザ上で「Sub test2()」という文字列をコピーして
エクセルに戻ってtest()を実行してみたところ、下記の4行が表示されました。
0
44
48
50
残念ながら私にはこれをどのように利用すれば良いか分からず・・・。
せっかくお返事いただいたのに活用しきれず申し訳ありません。
No.2
- 回答日時:
本質問の回答としては、#1 ご回答のように
Application.ClipboardFormats
で解決(あとは使い方と工夫の問題)すると思います。
IsClipboardFormatAvailable API を使うとこんな感じで細かな
条件分岐も可能ですよ。ただ本来数行で済むものを、なぜこんなに
ソースが長くなっているのかは、別件で
なんで HTML ソースそのまんま貼りつかねーのさ
ヾ(*`Д´*)ノ"
ってうなってたからです。
タイムリーすぎ。。と思ってしまったからです。
Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function RegisterClipboardFormat Lib "user32.dll" _
Alias "RegisterClipboardFormatA" ( _
ByVal lpString As String) As Long
Private Declare Function GetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Long, _
ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" ( _
ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal Destination As Long, _
ByVal Source As Long, _
ByVal Length As Long)
Private Const GMEM_MOVEABLE As Long = &H2
Private Const CF_UNICODETEXT As Long = 13
Sub PasteSample()
Dim CF_HTML As Long ' Html
Dim CF_LINK As Long ' Range Object
CF_LINK = RegisterClipboardFormat("LINK")
CF_HTML = RegisterClipboardFormat("HTML Format")
If IsClipboardFormatAvailable(CF_LINK) Then
' セルのコピーの場合。。。application.CutCopyModeでも判断できそう
Selection.PasteSpecial Paste:=xlValues
ElseIf IsClipboardFormatAvailable(CF_HTML) Then
' IE で Web ページをコピーした場合( CF_HTML )
ActiveSheet.PasteSpecial Format:="Unicode テキスト"
ElseIf IsClipboardFormatAvailable(CF_UNICODETEXT) Then
Dim buf As String
buf = ClipBoardGetText()
If InStr(1, buf, "<html", vbTextCompare) Or InStr(1, buf, "<body", vbTextCompare) Then
' Htmlソースのコピー等はソースのまま貼り付けてみる
' ...っぽく見せかけるの...無理やり...(´д` ;)
Dim v As Variant
v = Split(buf, vbCrLf)
Selection.Cells(1).Resize(UBound(v)).Value = Application.Transpose(v)
Else
' 単純テキストの場合
ActiveSheet.PasteSpecial Format:="Unicode テキスト"
End If
Else
' その他
ActiveSheet.Paste
End If
End Sub
' // クリップボードから Unicode Text を取得する
'
Public Function ClipBoardGetText() As String
Dim hMem As Long
Dim lp As Long
Dim sz As Long
Dim buf() As Byte
If OpenClipboard(0&) <> 0 Then
hMem = GetClipboardData(CF_UNICODETEXT)
If hMem <> 0 Then
lp = GlobalLock(hMem)
sz = GlobalSize(hMem)
ReDim buf(0 To sz)
MoveMemory VarPtr(buf(0)), lp, sz
GlobalUnlock hMem
End If
CloseClipboard
ClipBoardGetText = Left$(buf, InStr(buf, vbNullChar) - 1)
End If
End Function
' // クリップボードに Unicode Text をコピーする
'
Public Function ClipBoardSetText(ByVal srcText As String) As Boolean
Dim hMem As Long
Dim lp As Long
Dim sz As Long
Dim buf() As Byte
If OpenClipboard(0&) <> 0 Then
EmptyClipboard
buf = srcText & vbNullChar
sz = UBound(buf) - LBound(buf) + 1
hMem = GlobalAlloc(GMEM_MOVEABLE, sz)
If hMem <> 0 Then
lp = GlobalLock(hMem)
MoveMemory lp, VarPtr(buf(LBound(buf))), sz
GlobalUnlock hMem
ClipBoardSetText = CBool(SetClipboardData(CF_UNICODETEXT, hMem) <> 0)
End If
CloseClipboard
End If
End Function
No.3ベストアンサー
- 回答日時:
ついでに Application.ClipboardFormats を使った簡易サンプル。
なお、HTMLソースのコピーの場合は、テキスト貼り付けになりません。
対策するなら、#2 のようにクリップボードから直接テキストを
取り出して自前処理する必要があります。
Public Sub Sample2()
If IsCBFormatAvailable(xlClipboardFormatLink) Then
Selection.PasteSpecial Paste:=xlPasteValues
ElseIf IsCBFormatAvailable(xlClipboardFormatText) Then
ActiveSheet.PasteSpecial Format:="Unicode テキスト"
Else
' その他...Excel でも Shape とか Graph がありますよね
ActiveSheet.Paste
End If
End Sub
' // 指定したフォーマットのデータがクリップボードにあるか?
'
Public Function IsCBFormatAvailable(ByVal wFormat As XlClipboardFormat) As Boolean
Dim fmt As Variant
For Each fmt In Application.ClipboardFormats
If CLng(fmt) = wFormat Then
IsCBFormatAvailable = True
Exit For
End If
Next
End Function
簡易版も作ってくださりありがとうございました!まだ実際には試せていませんが、
On Errorステートメントで対処するよりもちゃんとifで分岐させた方が気持ちが良いし、
今のところ外部からはテキスト以外のものをマクロで貼り付けることはしませんが
もし何かそうなった時にも対応できそうなので、
KenKen_SP様のコードを使わせていただこうと思います。
ありがとうございました!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【マクロ】PasteSpecialメソッドにて、コードが動かない理由が分かりません 2 2023/08/15 20:47
- Excel(エクセル) VBA 特定の列に入っているテキストをコピペ 2 2023/06/14 11:24
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/04 17:58
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Excel(エクセル) エクセルのマクロでコピー後の貼り付け先を毎回指定したところにしたい 5 2022/08/12 10:47
- Visual Basic(VBA) Excel(VBA) 特定の条件に該当する行の値、書式を同じセルにコピ&ペーストしたいです 1 2022/05/21 18:18
- Visual Basic(VBA) Excel vbaについて知恵もしくは、コード教えて下さいm(__)m ① 表にあるデータをコピー、 2 2022/09/01 23:57
- Excel(エクセル) 複数のExcelブックのシート1の内容を1つのExcelブックにコピー貼り付けたいのでvbaコードを 7 2023/02/10 23:20
- Excel(エクセル) エクセルのマクロについて教えてください。 3 2023/02/07 14:47
- Visual Basic(VBA) 4月~3月まで12カ月横に並んだ表へ指定範囲を貼り付けたい。 Sheet2の指定範囲、Range(" 2 2022/11/30 16:37
このQ&Aを見た人はこんなQ&Aも見ています
-
新NISA制度は今までと何が変わる?非課税枠の拡大や投資対象の変更などを解説!
少額から投資を行う人のための非課税制度であるNISAが、2024年に改正される。おすすめの銘柄や投資額の目安について教えてもらった。
-
エクセル:マクロ「Application.CutCopyMode = False」って?
Excel(エクセル)
-
【EXCEL2002】「貼り付け先の書式に合わせる」をVBAで実行したい
Excel(エクセル)
-
VBA 数値を文字列として貼付したい
Excel(エクセル)
-
-
4
EXCELで特定のセルに表示された項目をヘッダーやフッターに出力するには
Excel(エクセル)
-
5
エクセルのエラーメッセージ「400」って?
Visual Basic(VBA)
-
6
エクセルVBA テキストボックスに3桁ごとにコンマ
Visual Basic(VBA)
-
7
ワードからエクセルへ貼り付けるマクロ
Excel(エクセル)
-
8
Excel VBAで改行を含む文字列を1つのセルに貼り付け
Excel(エクセル)
-
9
VBA フォームのテキストボックスにセルの値を表示させたいが改行していたら改行もあわせて表示させたい
Excel(エクセル)
-
10
VBA シートをコピーする際に Copyメソッドは失敗しましたのエラーが出てしまいます
Visual Basic(VBA)
-
11
ExcelVBA メモ帳を起動し名前を付けて指定フォルダに保存
Visual Basic(VBA)
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセル:マクロ「Application...
-
エクセルの2ページ目の作り方
-
エクセルのアポストロフィを一...
-
エクセルで勝手に「折り返して...
-
Excel 行の連続データを列に参...
-
EXCELシートをPowerPointにきれ...
-
「選択範囲を解除してアクティ...
-
EXCELのオートフィルの設定を変...
-
メールソフト「サンダーバード...
-
Excelに、ダブルクォーテーショ...
-
エクセルでの行数・列数を指定...
-
Excel)軽いデーターのはずなの...
-
EXELで複数のとびとびのセルを...
-
エクセルオートフィルで書式を...
-
Excelでコピーした行の挿入を繰...
-
EXCEL数値が存在する列の項目名...
-
エクセル・数値が変化したらカ...
-
エクセルで隣接していない複数...
-
フォームのテキストボックスの...
-
Excelの連続データから数行おき...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセル:マクロ「Application...
-
エクセルの2ページ目の作り方
-
エクセルのアポストロフィを一...
-
Excel 行の連続データを列に参...
-
エクセルで勝手に「折り返して...
-
Excelでコピーした行の挿入を繰...
-
EXCELのオートフィルの設定を変...
-
EXCELシートをPowerPointにきれ...
-
エクセルで、選択範囲の数値全...
-
Excel)軽いデーターのはずなの...
-
メールソフト「サンダーバード...
-
エクセルでの行数・列数を指定...
-
「選択範囲を解除してアクティ...
-
Excelに、ダブルクォーテーショ...
-
エクセル 別シートへのコピー...
-
エクセルオートフィルで書式を...
-
エクセルで値だけコピーして背...
-
EXELで複数のとびとびのセルを...
-
Excelで、横並べのデータを縦並...
-
エクセル・数値が変化したらカ...
おすすめ情報