経理屋とVBAの日記

経理業務で役に立つかもしれないExcel/Access VBAのネタを書きます

【VBA】64ビット版対応って結局何をすればいいの?

結論

そもそも

当ブログ一発目にこの話題を選んだ理由がこれです。
iOS 11 のアップデートについて - Apple サポート

iOS 11は64ビットApp用にパフォーマンスが最適化されています。32ビットAppをこのバージョンのiOSで動作させるにはデベロッパ によるアップデートが必要になります。

 要は「iOS11以降32ビットのアプリは動きませんよ」ということです。ついに来たかという感じですね。
 ちなみにmacOSも現在のHigh Sierraが32ビットアプリをサポートする最後のバージョンになるそうです。OS Xが64ビット版のみになってから既に5年半も経っていることを思えば当然の流れだと言えるでしょう。


 さて、この記事を書いている2017/10/29現在でもMicrosoftはOfficeについて32ビット版のインストールを推奨しています。Windowsは最新バージョンであるWindows 10でも32ビット版を用意していますし、Apple製品のように近々で32ビットアプリが使えなくなるというようなことはないと考えられます。
 しかし、上記のような状況を踏まえれば、今から新しく起こすVBAのコードや、5年前に辞めたあの人が遺したアレの64ビット版対応というのは決して優先順位の低いものではないと


そうクダを巻いて多めに工数をもらいましょう。

補足

Excel: Declaring API functions in 64 bit Office
を見て各関数の宣言をコピペするというのも一つの正解なのですが、宣言が長くなりますし、メンテナンスできる人も一層限られますし、なにより今更2007に対応する必要もないと思いますので
極力条件付きコンパイルは避けてDeclareしたいと思います。


①DeclareステートメントにPtrSafe属性を追加する
これは特に補足することもないですね。

Declare Sub/Function Hoge ~

Declare PtrSafe Sub/Function Hoge ~

に変えるだけです。この文言が入っていないと64ビット環境ではコンパイルエラーになります。


②ポインタ及びハンドルを代入する変/定数をLong型からLongPtr型に変更する
一番難しいところだと思います。
詳しい説明は他のサイト様に委ねるとして、要はポインタだハンドルだと呼ばれるものは32ビット環境と64ビット環境でサイズ(大きさ)が違いますよ、だからそれぞれで違うサイズの型を使いましょうねということです。
LongPtr データ型
こちらに説明がありますがLongPtr型というのは32ビット環境と64ビット環境とでサイズの異なる整数型に解決されます。


…じゃあ全部LongPtrにしちゃえば良くない?といつかの私は思いました。ダメでした。
例えば下記のコードを64ビット環境で実行するとエラーが出ます。

Sub test()

    Dim c As LongPtr
    Dim hoge() As Variant
    
    c = Selection.Count
    ReDim hoge(c)

End Sub

恐らくですが配列の長さの最大数がLongLong型のそれより小さいのでしょう。仕方がないです。


あとはやはりよく分からないコードをよく分からないまま使うのは純粋に良くないかなと思います。
良くないかなというか、いいんですが、後で必ず自分が痛い目を見ます。
最適な変数に最適な型を指定しましょう。


③条件付きコンパイルを設定する
これらの上位互換である
・GetWindowLongPtr
・SetWindowLongPtr
関数。MSDNには32ビットと64ビットで互換性があると書かれていますが、VBAにおいては嘘です。
32ビット環境でPtr付きの関数を実行しようとすると普通にエラーが出ますので、泣く泣く条件付きコンパイルを設定しましょう。
Set~の方だけですが

#If Win64 Then
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongPtrA" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#Else
    Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As LongPtr) As LongPtr
#End If

こんな感じですね。エイリアスを設定することによって実体がどちらであれ「SetWindowLong」の名前で使用できるようにします。

実践

Excel VBA を学ぶなら moug モーグ | 即効テクニック | クリップボードへデータを送信する方法
VBAクリップボードを操作する方法はいくつかありますが、ループ系の処理ではやっぱりAPIを使うのが一番安定するんですよね。
というわけで実際にこれを64ビット環境で動かしてみます。

Option Explicit

'指定したサイズ分のメモリを割り当て
Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" ( _
    ByVal wFlags As Long, _
    ByVal dwBytes As LongPtr) As LongPtr

'メモリブロックをロックして最初の1バイトへのポインタを返す
Private Declare PtrSafe Function GlobalLock Lib "kernel32" ( _
    ByVal hMem As LongPtr) As LongPtr

'バッファに文字列をコピー
Private Declare PtrSafe Function lstrcpy Lib "kernel32" ( _
    ByVal lpString1 As LongPtr, _
    ByVal lpString2 As String) As LongPtr

'メモリのロックを解除
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" ( _
    ByVal hMem As LongPtr) As Long

'クリップボードを排他的に開く
Private Declare PtrSafe Function OpenClipboard Lib "User32" ( _
    ByVal hWnd As LongPtr) As Long

'クリップボードを初期化
Private Declare PtrSafe Function EmptyClipboard Lib "User32" ( _
    ) As Long

'クリップボードにデータを渡す
Private Declare PtrSafe Function SetClipboardData Lib "User32" ( _
    ByVal wFormat As Long, _
    ByVal hMem As LongPtr) As LongPtr

'クリップボードを閉じる
Private Declare PtrSafe Function CloseClipboard Lib "User32" ( _
    ) As Long

'GlobalAlloc
Private Const GHND = &H42
'SetClipboardData
Private Const CF_TEXT = &H1

Public Function SetClipBoard(setStr As String) As LongPtr
    
    Dim hGlobalMemory As LongPtr
    Dim lpGlobalMemory As LongPtr

    'ヒープからメモリを確保
    hGlobalMemory = GlobalAlloc(GHND, LenB(setStr) + 1)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    If lpGlobalMemory = 0 Then
        MsgBox "メモリを確保できません", vbExclamation
        Exit Function
    End If
    
    '確保したメモリに文字列を保存し、ロックを解除
    Call lstrcpy(lpGlobalMemory, setStr)
    Call GlobalUnlock(hGlobalMemory)

    'メモリからクリップボードにデータを渡す
    If OpenClipboard(0) = 0 Then
        MsgBox "クリップボードが開けません", vbExclamation
        Exit Function
    End If
    Call EmptyClipboard
    SetClipBoard = SetClipboardData(CF_TEXT, hGlobalMemory)
    Call CloseClipboard 'クリップボードは開いたら必ず閉じる

End Function

不要な部分はバッサリ削っていますが、基本的には上記①②だけです。
元のコード及びMSDNにらめっこしながら確認してみてください。

終わりに

色々書きましたが一番手っ取り早いのは
「とりあえず64ビット版を入れてみる」
ことだと思います。動かなくても一つ一つ戻り値を確認していけば
思ったほど大変な作業にはならないでしょう。