VBA クリップボードの値を取得する方法(API) 64Bit対応版 - Excel
VBAでAPIを利用してクリップボードの値を取得する方法です。
以前、こちらのページで紹介した「コピーされたセル範囲を取得する方法」の64Bit対応版だと思ってください。
まず、64Bit版 になると、API が 32Bit版 と同じ作法では動作できず、コンパイルエラーが発生します。
Office 32Bit 版と 64Bit 版の違いについては、こちらで詳しく説明しています。
また、Microsoft は 64Bit版の Office より、32Bit版の Office をおすすめしています。
・Office 2013 の 64 ビット版
http://technet.microsoft.com/ja-jp/library/ee681792(v=office.15).aspx
Sponsored Links
コピーされたセル範囲を取得する方法のサンプルソース
それでは、標準モジュールを開いて以下のソースをコピペしてください。
Option Explicit #If VBA7 And Win64 Then Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr Private Declare PtrSafe Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr Private Declare PtrSafe Function MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As LongPtr) As LongPtr Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long #Else Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long Private Declare Function GlobalLock Lib "kernel32" (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 Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long #End If '** ' コピーアドレスの取得 '** Public Function GetCopyAddress(SheetName As String) As String On Error GoTo ErrHandler Dim i As Long Dim Format As Long Dim Data() As Byte Dim Address As String #If VBA7 And Win64 Then Dim hMem As LongPtr Dim Size As LongPtr Dim p As LongPtr #Else Dim hMem As Long Dim Size As Long Dim p As Long #End If Call OpenClipboard(0) hMem = GetClipboardData(RegisterClipboardFormat("Link")) If hMem = 0 Then Call CloseClipboard Exit Function End If Size = GlobalSize(hMem) p = GlobalLock(hMem) ReDim Data(0 To CLng(Size) - CLng(1)) #If VBA7 And Win64 Then Call MoveMemory(Data(0), ByVal p, Size) #Else Call MoveMemory(CLng(VarPtr(Data(0))), p, Size) #End If Call GlobalUnlock(hMem) Call CloseClipboard For i = 0 To CLng(Size) - CLng(1) If Data(i) = 0 Then Data(i) = Asc(" ") End If Next i Address = StrConv(Data, vbUnicode) Debug.Print "Address: " + Address If InStr(Address, "]" & SheetName) <> 0 Then GetCopyAddress = Trim(Replace(Mid(Address, InStr(Address, "]" & SheetName)), "]" & SheetName, "")) Else GetCopyAddress = "" End If Exit Function ErrHandler: Call CloseClipboard GetCopyAddress = "" End Function
次に、シートの Worksheet_SelectionChange
に以下のソースを記述します。
Option Explicit '** ' ワークシート選択変更 '** Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Cells As String Dim CopyRange As Range ' コピーモードの場合 If Application.CutCopyMode = xlCopy Then ' セルを取得 Cells = GetCopyAddress(Me.Name) Debug.Print "### コピーされたセル ###" Debug.Print "R1C1形式: " & Cells ' R1C1形式からA1形式に変換 Set CopyRange = Range(Application.ConvertFormula(Cells, xlR1C1, xlA1)) Debug.Print "A1形式: " & CopyRange.Address End If End Sub
テスト
画像のようにセルに値を埋めてコピーし、セルを移動してみてください。
結果は以下のようになります。
### コピーされたセル ### R1C1形式: R1C1:R5C3 A1形式: $A$1:$C$5
Sponsored Links
参考サイト
・Share the Clipboard with VBA and the Windows API Francesco Foti's weblog
http://francescofoti.com/2013/12/11/share-the-clipboard-with-vba-and-the-windows-api/
まとめ
VBAでAPIを利用してクリップボードの値を取得する方法を紹介しました。
このように、既存の 32Bit版 で作られた VBA プログラムは、その多くが 64Bit 版では動作しません。64Bit 版の Office を導入する際は、よく検討することが必要となります。
おつかれさまでした。
Sponsored Links