エクセルVBAでクリップボードのテキストデータを取得する関数を書いてみた

クリップボードのテキストデータを取得する関数を書いてみた

コピーした文字列をエクセルのシートのセルA1に書き込んでみる場合

f:id:gogowaten:20191015165337p:plain

文字をコピーしてから

関数を実行で

書き込めた！

これだけ！

書いたのが

'クリップボード系API宣言
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long 
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long

'メモリ系API宣言
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'http://msdn.microsoft.com/ja-jp/library/cc430080.aspx
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Public Const CF_TEXT As Long = 1 'テキストデータ用



Function クリップボードのテキストを返す2() As String
    Dim RetVal As Long 'CloseClipboardやlstrcpyとかの戻り値を受け取る用、関数で戻り値があるから受け取った方がいい？
    Dim cData As Long
    Dim mAddress As Long
    Dim gSize As Long
    Dim MyString As String
    
    'OpenClipboardでクリップボードを開く
    If OpenClipboard(0) = 0 Then
        MsgBox "クリップボードを開けない、他のアプリが使っている可能性が巨レ存"
        Exit Function
    End If
    
    'GetClipboardDataでテキストのアドレス取得
    cData = GetClipboardData(CF_TEXT)
     
    If cData = 0 Then
        MsgBox "クリップボードにテキストはなかったよ"
        RetVal = CloseClipboard()
        Exit Function
    End If
    
    'データの差し押さえ、テキストのあるメモリアドレス(ハンドル)を取得と同時にロック
    mAddress = GlobalLock(cData)
    If mAddress = 0 Then
        MsgBox "メモリをロックできなかったよ"
        RetVal = CloseClipboard()
        Exit Function
    End If
    
    'テキストデータの長さを取得、
    gSize = GlobalSize(mAddress) 'コピペ元のサイズ取得
        
    MyString = String(gSize, Chr(0)) 'コピペ先の場所確保、Chr(0)の空白で埋める
    RetVal = lstrcpy(MyString, mAddress) 'コピペ！！！！！！！！！！！！！！！！
    GlobalUnlock (cData) 'メモリのアンロック＼(^o^)／！！！！！！！！！！！
    
    '余分な空白を取り除く
    MyString = Left(MyString, InStr(1, MyString, Chr(0)) - 1) '-1は終端のnull文字を削除するため
        
    RetVal = CloseClipboard() 'クリップボードを閉じる
    クリップボードのテキストを返す2 = MyString
End Function


Sub クリップボードにテキストがあればA1に書き込む()
    ActiveSheet.Range("a1").Value = クリップボードのテキストを返す()
    
End Sub

画像だと

f:id:gogowaten:20191015165421p:plain

コメントアウトのところはカオスっている

始まりはエクセルのシート上にある図形、グラフ、スマートアートその他を

個別に画像として保存したいってのがあって

これがエクセルだけだとうまくいかない

クリップボードとWIN32API、APIとかを使うとできるらしい

でも難しいので最初はテキストデータからになった

クリップボードから情報を取得する方法

http://msdn.microsoft.com/ja-jp/library/office/ff194373(v=office.15).aspx

Excel VBA を学ぶなら moug モーグ | 即効テクニック | クリップボードのデータを取り出す方法

http://www.moug.net/tech/acvba/0020003.html

Accessようだけど解説があるのでコピペして実行するとクリップボードに

テキストデータがある場合は動くけれどない場合にエラーになる

f:id:gogowaten:20191015165437p:plain

画像をコピーして実行すると

f:id:gogowaten:20191015165446p:plain

エラーになる

赤枠のところが原因

   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo OutOfHere
   End If

クリップボードのテキストデータの有無の判定にIsNullってのを使っていて

これがうまく判定できていないみたい、エクセルだから？

    If cData = 0 Then
        MsgBox "クリップボードにテキストはなかったよ"
        RetVal = CloseClipboard()
        Exit Function
    End If

エクセル用？に0かそれ以外で判定するように書き換えた結果は

メッセージを表示して終了できた

GetClipboardData 関数

http://msdn.microsoft.com/ja-jp/library/cc429794.aspx

とか見てもデータがなかった場合はNullが返ってくるって書いてあるのは

エクセル用の説明じゃないからかな、難しい…

Nullってのが馴染みがなくてNothingやEmptyとどう違うのか検索すると

NullとEmptyとNothingと空の文字列の違い：Access VBA｜即効テクニック｜Excel VBAを学ぶならmoug

http://www.moug.net/tech/acvba/0050010.html

これもエクセルではなくてアクセス用だけど、ややこしくてよくわからんｗ

実際にどんな値が入ってどんな判定になるのがやってみた結果

クリップボードに画像をコピーした状態で

    Dim cData As Long
    If cData = Null Then Debug.Print "null" 'nullではない
    If cData = 0 Then Debug.Print "0" 'これは0
    'If cData Is Nothing Then Debug.Print "nothing"’型が違うと言われる
    If cData = Empty Then Debug.Print "empty" 'これもEmptyの判定
    Debug.Print IsNull(cData) 'falseになる
    Debug.Print IsEmpty(cData) 'こっちのEmptyはFalseになる、Variant型だとTrue
    Debug.Print TypeName(cData) 'Long、Variant型だとEmpty

ここまでは何も入っていない状態での判定結果

ここから入れてからの判定

    cData = GetClipboardData(CF_TEXT)
    'テキストがない時はnullが入る、といっても実際は0が入るので0かemptyで判定できる
    'そもそもnullはVariant型専用らしい
    If cData = Null Then Debug.Print "null"'→nullではない
    If cData = 0 Then Debug.Print "0" '→0
    If cData = Empty Then Debug.Print "empty" '→Empty
    Debug.Print IsNull(cData) '→False
    Debug.Print IsEmpty(cData) '→False
    Debug.Print TypeName(cData) '→Long、Variant型の宣言でもLongになる