クリップボードから情報を取り出すには、Windows APIの関数を呼び出すVBA
関数を定義する必要があります。このサンプルではクリップボードからテキスト
を取り出す関数を定義します。
● サンプル ●
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 "クリップボードが開きません"
Exit Function
End If
' テキストを参照しているグローバル メモリ
' のブロックへのハンドルを取得します。
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutOfHere
End If
' クリップボードのメモリをロックし、実際の
' データ文字列を参照します。
lpClipMemory = GlobalLock(hClipMemory)
If Not IsNull(lpClipMemory) Then
MyString = Space$(MAXSIZE)
RetVal = lstrcpy(MyString, lpClipMemory)
RetVal = GlobalUnlock(hClipMemory)
' null 終了文字を削除します。
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
|