VBA クリップボードの値を取得する方法(API) 64Bit対応版 - Excel

VBAでAPIを利用してクリップボードの値を取得する方法です。

VBA クリップボードの値を取得する方法(API) 64Bit対応版 - Excel

以前、こちらのページで紹介した「コピーされたセル範囲を取得する方法」の64Bit対応版だと思ってください。

VBA コピーされたセル範囲を取得する方法

まず、64Bit版 になると、API が 32Bit版 と同じ作法では動作できず、コンパイルエラーが発生します。

Office 32Bit 版と 64Bit 版の違いについては、こちらで詳しく説明しています。

VBA 32Bit版と64Bit版でDeclareステートメントの宣言を分ける方法

また、Microsoft は 64Bit版の Office より、32Bit版の Office をおすすめしています。

・Office 2013 の 64 ビット版

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


コピーされたセル範囲を取得する方法のサンプルソース

それでは、標準モジュールを開いて以下のソースをコピペしてください。

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

テスト

画像のようにセルに値を埋めてコピーし、セルを移動してみてください。

VBA コピーされたセル範囲を取得する方法

結果は以下のようになります。

### コピーされたセル ###
R1C1形式: R1C1:R5C3
A1形式: $A$1:$C$5

参考サイト

・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 を導入する際は、よく検討することが必要となります。

おつかれさまでした。

この記事がお役に立ちましたら シェア をお願いいたします。