VBA クリップボードの値を取得する方法(API) 64Bit対応版 - Excel ホームページ制作 | 墨田区

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

LINEで送る
Pocket

VBA クリップボードの値を取得する方法(API) 64Bit対応版 - Excel VBAでAPIを利用してクリップボードの値を取得する方法をご紹介します。
以前、こちらのページで紹介した「コピーされたセル範囲を取得する方法」の64Bit対応版だと思ってください。
VBA コピーされたセル範囲を取得する方法 – Excel

まず、64Bit版 になると、API が 32Bit版 と同じ作法では動作できず、コンパイルエラーが発生します。
Office 32Bit 版と 64Bit 版の違いについては、こちらで詳しく説明しています。
VBA 32Bit版と64Bit版でDeclareステートメントの宣言を分ける方法 – Office 2010,2013

また、Microsoft は 64Bit版の Office より、32Bit版の Office をおすすめしています。
・Office 2013 の 64 ビット版
http://technet.microsoft.com/ja-jp/library/ee681792(v=office.15).aspx




【PR】マジか?!「アレ」してるLINEスタンプっていったい・・・


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

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

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/


このように、既存の 32Bit版 で作られた VBA プログラムは、その多くが 64Bit 版では動作しません。64Bit 版の Office を導入する際は、よく検討することが必要となります。

おつかれさまでした。

LINEで送る
Pocket

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

Office / VBAの勉強が思うように進まないときは!

Office / VBAの勉強が思うように進まないのであれば、プロに直接質問ができる プログラミングスクール を検討してみてはいかがでしょうか?プログラミングスクールに申し込めば、短期間で一定のスキルを身に着けることができます!

Office / VBAコースあり!未経験者にウケてる KENスクール パソコンスクール・パソコン教室 【KENスクール】個別指導のWeb-DTP・OA・IT PCスクール

理解度や学習ペースに合わせて、一人ひとりが納得して前進できる授業を提供してくれるのが特徴です。特に課題製作は現場さながらで、実務に即したものとなっていますので短期でのスキルアップが望めます。自宅学習のサポートも充実していて、授業内容をいつでもビデオで振り返ることができるのもうれしいですね。好きな時間に好きな場所で、無理なくスケジューリングできるので、仕事の忙しい方でも柔軟に学ぶことができますよ。

更にさらに、なんと 就職サポート をしてくれるというのですから驚きです!!

履歴書の書き方から面接指導、求人の紹介など、具体的な就職先まで提案してくれるんです!私も「もっと早く出会いたかったなぁー、こんなスクール」・・・って思っちゃいました^^

東京・神奈川・愛知・大阪を営業エリアとされています。
まずは気軽に 無料体験予約 に申し込んでみるのもアリですよ。


コメント - Thank you for the comment.

  1. まひと

    2015/11/18 10:22

     

    お世話になります。

    OS,キーボードが英語環境の場合、全角文字が文字化けしてしまいますが、対処方法はあるでしょうか?

    よろしくお願い致します。

    返信

     
    •  

      コメントありがとうございます。OS,キーボード共に英語環境とはグローバルなお仕事をされているのでしょうか?まずVBAのコメント以外は英語になっていますでしょうか?関数名やモジュール名に日本語を使っていると文字化けして動作しないと思います。コメントも文字化けするかもしれませんが、こちらは無視してもいいでしょう。それ以外の方法としては、システムロケールの変更で解決できるかもしれません。Windows8の場合、コントロールパネルから「地域」を選び、「管理」タブから「Unicode対応ではないプログラムの言語」を「日本語」としてみてください。私の手元に英語OSがないので確かな情報ではないですが、以前、海外で仕事をしたときに日付の問題でハマったことがありました。その時は日付形式を変更することで解決しました。今回のまひとさんと同じ事象ではありませんが、「地域」や「言語」の設定で解決する可能性がありますので試してみてください。

      返信

       
  2. まひと

    2015/11/19 10:04

     

    返信有り難うございます。

    私の方(日本語環境)でアドインを作成し、それを国内外の不特定多数の方に使用してもらっています。

    説明不足ですみません。コピー元のブック名、シート名に全角文字が使われていると、英語環境ではコピー元のアドレスが文字化けとなってしまいます。

    地域、言語の設定で解決できるかもしれませんが、実際に使う方が国外の方なので、地域・言語の設定変更なしで対応したいと思いますが、何か対処方法は無いでしょうか?

    例えば、日本や中国の方だとブック名、シート名に漢字などの全角文字 (厄介なのが括弧など一見全角とは判断がつきにくい文字が使われてしまう事がある) を使う場合があり、それを他の英語圏 (シンガポールなど) の地域の方のPCでそのファイルを操作すると文字化けによるマクロエラーが発生します。(日本語環境のPCでは全角文字でもマクロで文字化けせず、エラーは発生しません。)
    全角文字をそもそも使わなければいいのですが、アドイン化したマクロは不特定多数の方が使うので、全角禁止は徹底できないかと思います。シート名変更やブック保存時に全角入力を検知して全角入力をできないようにすることはできると思いますが、それはそれでまた使い勝手が悪くなると思います。

    よろしくお願い致します。

    返信

     
    •  

      アドインの開発ですか。国内外の不特定多数のユーザーとなると、かなり検証が大変そうですね。私の方はそこまでの対応をしたことがないのであまり多くを語ることはできませんが、StrConv関数などを使っての対処などはどうでしょうか?実機がないので確かなことは言えませんが、Unicodeで扱わないと文字化けは解消しないと思います。

      返信

       
  3. まひと

    2015/11/25 23:45

     

    なかなかハードルが高そうです。うまく行きましたらまた報告致します。

    返信

     
    •  

      コメントありがとうございます。ご連絡お待ちしております。うまくいくといいですね。

      返信

       
      • まひと

        2015/12/03 23:38

         

        まだ解決というわけではありませんが、以下の事が分かりました。

        システムロケールをEnglishに変更すると、コピー元ブックの全角文字の部分でData()に格納される値が63 (= ?) となってしまい、これが原因で文字化けを起こしてしまうようです。
        逆に、ここの値を正しく取得できればUnicodeに変換できることは確認しました。

        ではなぜData()が正しく取得できないのか?APIの問題なのでしょうか?
        何か糸口があればいいのですが。

        返信

         
        •  

          コメントありがとうございます。

          >Data()に格納される値が63 (= ?)
          Call MoveMemory(Data(0), ByVal p, Size) or Call MoveMemory(CLng(VarPtr(Data(0))), p, Size) のData(0)が ? となっているということでしょうか?

          VB6の時代ですが、他国で使う場合、各言語向けのサテライトDLLが必要でした。日本はVB6JP.DLLだったかな・・。Unicodeパスもサポートされてなかった記憶があります。この辺りはVB.NETになって改善されたと思ってましたが、VBAはどうなんでしょうね。

          返信

           
  4. まひと

    2015/12/09 00:31

     

    コメントありがとうございます。

    よくよく変数の値を調べてみると、Size = GlobalSize(hMem)の時点で、英語環境だと本来2バイトで取得すべき文字が1バイトとなってしまっており、これがData()に格納される時に?になってしまうのだと思います。

    日本語OSでもコントロールパネルからシステムロケールを英語に変更すると問題は再現できます。
    例えば、同じ文字数のワークシート名となるように、英数字のみ使用した場合と平仮名のみを使用した場合で、後者は本来はワークシート名の文字数分だけSizeが大きくなるはずがなりません。

    無理やりバイト数を増やしても (Size=Size + 3とかしてみる) ダメですね。

    となると、
    hMem = GetClipboardData(RegisterClipboardFormat(“Link”))
    の時点で、全角文字があると正しく取得出来ていない、ということなのでしょうか?

    解決方法があるのかどうか。。。

    vbe7.dllのファイルを探してみましたが、言語に依存したファイルはなさそうでした。

    返信

     
    •  

      コメントありがとうございます。
      >hMem = GetClipboardData(RegisterClipboardFormat(“Link”))
      >の時点で、全角文字があると正しく取得出来ていない、ということなのでしょうか?
      なるほど、可能性は高いですね。GetClipboardDataの引数にはCF_LOCALEというテキストデータのロケールIDハンドルを指定できます。
      Ret = GetClipboardData(CF_LOCALE)などで得られた値をRtlMoveMemory APIの第2引数などに使うとどうなりますでしょうか?
      Sizeは4とか固定してみてください。

      すみません、時間がなくて試せていません・・・。見当違いな回答でしたらご容赦ください。

      返信

       
  5. まひと

    2015/12/14 18:45

     

    返信遅くなりすみません。

    クリップボードの中身をみるフリーウェアを見つけました。これが解決の糸口となりそうです。
    http://www.freeclipboardviewer.com/
    http://www5e.biglobe.ne.jp/~aya-wind/software/cc/index.html

    これらで試してみる限り、CF_LOCALEの値は、コピーした時点のIMEの言語に依存しているようです。なので、ファイルの作成者のLocale値は取得できないと思います。

    Link形式では、そもそも正しく文字コードを取得できていないので、他の形式をあたってみました。
    Clipboard Viewerの方は、右クリックでエンコードを指定できます。
    ブック名は、HTML形式で取得でき、エンコードをUTF-8にすると文字化けが直ります。
    ワークシート名は、HTMLには含まれておらず、Link Source Descriptorで2バイトずつ変換していけばできそうな気がします。(なぜかLink Source Descriptorでは、UTF-8でエンコードしても文字化けしたままです。)

    返信

     
    •  

      コメントありがとうございます。

      >ファイルの作成者のLocale値は取得できない
      なるほど、少し勘違いしていました・・・。ファイル作成者に限らず、利用者のLocaleがわかればいいものだと思っていました。

      しかし、すごいですね。だいぶ解決に近づいてきましたね^^

      返信

       
  6. まひと

    2015/12/16 11:59

     

    完全にデバッグしきれてはいませんが、解決しました!

    参考までにコード全体を載せようと思いますが、ちょっと長いので、コメント欄に書くのは適切ではないかと思います。

    ファイルを送信したいので、メールアドレスに宛先を返信頂けますでしょうか?

    返信

     
  7.  

    はじめまして
    64bitのエクセルでこちらを実行するとVarPtrが型エラーとなってしまいます。
    大変失礼ですが対処方法はございますでしょうか?

    返信

     
    •  

      コメントありがとうございます。変ですね、当方Excel2013 64Bit版 for Windowsにて検証しておりますが、特に型エラーは出ていません。実行環境はどのようなものでしょうか?また、具体的なエラーメッセージはどのようなものでしょうか?

      返信

       

コメントを残す

お名前 (必須)
メールアドレス
(アドレスは公開されません)

コメント(必須)

Trackback URL