【Wordマクロ】クリップボードへのデータ入力・取得のエラーへの対処

右クリックでGoogle！ のアップデートで気がつきました。

Windows 8 (64bit）で、どうやらクリップボードとの情報のやり取りがうまくいかないようでした。

その対処方法を紹介します。



▼今までの方法

通常は、DataObjectを使用して、クリップボードに情報を入れたり、またはクリップボードから情報を取得したりできるのです。

詳細は、Microsoft Excel MVPの田中亨先生のOffice TANAKAの以下の記事をご覧ください。


クリップボードを操作する(1)




▼代替案

Windows 8 (64bit) マシンで上記の方法でクリップボードを操作しようとしたときに、時々うまくいかないときがあります。バグみたいですね。

クリップボードにコピーしたはずのものを貼り付けると、以下のように2文字に変わってしまうのです。




最初は何のことかわからなかったのですが、正体はWingdingsフォントのWindowsのマークでした（笑）。





ネットを検索していたら、対処方法が出ていましたので紹介します。

クリップボードにコピー

How to: Send Information to the Clipboard

こちらは、クリップボードに情報を入力する方法。

Windows APIを操作する方法で対処できました。

新しい標準モジュール(Standard Module）を開き、以下のコードを貼り付けてください。


▼マクロ

Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _ 
   ByVal dwBytes As Long) As Long 
Declare Function CloseClipboard Lib "User32" () As Long 
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _ 
   As Long 
Declare Function EmptyClipboard Lib "User32" () As Long 
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ 
   ByVal lpString2 As Any) As Long 
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _ 
   As Long, ByVal hMem As Long) As Long 
 
Public Const GHND = &H42 
Public Const CF_TEXT = 1 
Public Const MAXSIZE = 4096









Function ClipBoard_SetData(MyString As String) 
   Dim hGlobalMemory As Long, lpGlobalMemory As Long 
   Dim hClipMemory As Long, X As Long 
 
   ' Allocate moveable global memory. 
   '------------------------------------------- 


　 MyString = MyString & Chr(0)　 ’追記しました。





   hGlobalMemory = GlobalAlloc(GHND, LenB(MyString) + 1) 
 
   ' Lock the block to get a far pointer 
   ' to this memory. 
   lpGlobalMemory = GlobalLock(hGlobalMemory) 
 
   ' Copy the string to this global memory. 
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString) 
 
   ' Unlock the memory. 
   If GlobalUnlock(hGlobalMemory) <> 0 Then 
      MsgBox "Could not unlock memory location. Copy aborted." 
      GoTo OutOfHere2 
   End If 
 
   ' Open the Clipboard to copy data to. 
   If OpenClipboard(0&) = 0 Then 
      MsgBox "Could not open the Clipboard. Copy aborted." 
      Exit Function 
   End If 
 
   ' Clear the Clipboard. 
   X = EmptyClipboard() 
 
   ' Copy the data to the Clipboard. 
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory) 
 
OutOfHere2: 
 
   If CloseClipboard() = 0 Then 
      MsgBox "Could not close Clipboard." 
   End If 
 
End Function

▼使い方

他のモジュールから、このFunctionプロシージャ（関数のことです）を呼び出せます。

他のモジュールのプロシージャーから、以下のように文字列を入れると、自動的にクリップボードにその文字列がコピーされます。

ClipBoard_SetData(文字列)

▼変更点





後日、コメントにて記事の不備をご指摘いただきました。





当時書いていた5行目の修正点は元に戻しました。





5行目の前に1行以下の文章を追加しました。





MyString = MyString & Chr(0)





これでうまく動きます。














▼注意点　（後ほど追記）




日本語の文字列をクリップボードにいれてから、その文字列を取り出すと



（貼り付けると）最後の1文字が欠けてしまいました。




対応としてFunctionプロシージャの5行目の数字を変えました。





たまたま数字をいじっていたところ、5にしたらうまくいきました。



3でもいいですが、文字列が長くなった場合に最後の１文字が欠けます。




理由はわかりません（笑）。






（変更前）





   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1) 

（変更後）





   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 5) 






しかも、複数段落の長い文字列をクリップボードに入れようとすると



Wordが落ちました。。。




扱いは慎重にした方がいいかもしれません。





 





クリップボードから情報取得

How to: Retrieve Information from the Clipboard)

こちらは、クリップボードの情報を取得する方法。

こちらも、別の新しい標準モジュールを開いてコピペしてください。


▼マクロ

Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _ 
   As Long 
Declare Function CloseClipboard Lib "User32" () As Long 
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _ 
   Long) As Long 
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _ 
   dwBytes As Long) As Long 
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ 
   ByVal lpString2 As Any) As Long 
 
Public Const GHND = &H42 
Public Const CF_TEXT = 1 
Public Const MAXSIZE = 4096








Function ClipBoard_GetData() 
   Dim hClipMemory As Long 
   Dim lpClipMemory As Long 
   Dim MyString As String 
   Dim RetVal As Long 
 
   If OpenClipboard(0&) = 0 Then 
      MsgBox "Cannot open Clipboard. Another app. may have it open" 
      Exit Function 
   End If 
          
   ' 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 
 
   ' Lock Clipboard memory so we can reference 
   ' the actual data string. 
   lpClipMemory = GlobalLock(hClipMemory) 
 
   If Not IsNull(lpClipMemory) Then 
      MyString = Space$(MAXSIZE) 
      RetVal = lstrcpy(MyString, lpClipMemory) 
      RetVal = GlobalUnlock(hClipMemory) 
       
      ' Peel off the null terminating character. 
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1) 
   Else 
      MsgBox "Could not lock memory to copy string from." 
   End If 
 
OutOfHere: 
 
   RetVal = CloseClipboard() 
   ClipBoard_GetData = MyString 
 
End Function

▼使い方

他のモジュールから、このFunctionプロシージャ（関数のことです）を呼び出せます。

MsgBox ClipBoard_GetData

このコードを実行すると、クリップボード内の文字列がメッセージボックスに表示されます。



▼関連記事

右クリックでGoogle！