VBA GettickCount 64/32BIT共通版(ClassModule使用)

コード

Option Explicit
'1/5 Declrare Section For Win32API
'2/5 Enum Section For Win32API <This Module is none.
'3/5 Type Section For Win32API <This Module is none.
'4/5 Const Section For Win32API <This Module is none.
'5/5 Function Section For Win32API <This Module is none.

'Original Type SataeMent

'GetTickCount（64） 戻り値  ・・・  システムを起動した後の経過時間（ミリ秒（ms）単位で取得）を表す DWORD 型の値（VBA では、64bitではLonglong,VBA7 32bit ではLong,  型 に該当）。
#If VBA7 Then
#If Win64 Then
Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
#Else
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If
#Else
Declare Function GetTickCount Lib “kernel32” () As Long
#End If
'Original Type SataeMent///////////////////////
'Q11Q Setting Constructer GettickTime用構造体
#If VBA7 Then
#If Win64 Then
Type Getick
StartTime As LongLong
NOWTime As LongLong
EndTime As LongLong
End Type
#Else
StartTime As LongPtr
NOWTime As LongPtr
EndTime As LongPtr
End Type
#End If
#Else
StartTime As Long
NOWTime As Long
EndTime As Long
End Type
#End If

Sub API_Test_GetTickCount()
Dim GetTickType As Getick
'Start
#If VBA7 Then
#If Win64 Then
GetTickType.StartTime = GetTickCount64
#Else
GetTickType.StartTime = GetTickCount
#End If
#Else
GetTickType.StartTime = GetTickCount
#End If
Debug.Print CStr(GetTickType.StartTime / 1000)

'Now
#If VBA7 Then
#If Win64 Then
GetTickType.NOWTime = GetTickCount64
#Else
GetTickType.NOWTime = GetTickCount
#End If
#Else
GetTickType.NOWTime = GetTickCount
#End If
Debug.Print CStr(GetTickType.NOWTime / 1000)

'End
#If VBA7 Then
#If Win64 Then
GetTickType.EndTime = GetTickCount64
#Else
GetTickType.EndTime = GetTickCount
#End If
#Else
GetTickType.EndTime = GetTickCount
#End If
Debug.Print CStr((GetTickType.EndTime - GetTickType.StartTime) / 1000)
End Sub

公式サイトのヘルプファイルから場合分けが3つ必要

Win32API_PtrSafe.txt 2342行に次のように記載されている

#If Win64 Then
Declare PtrSafe Function GetTickCount64 Lib "kernel32" Alias "GetTickCount64" () As LongLong
#End If

Declare PtrSafe Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

64Bitは関数名がGettickcount64になり、返り値はLongLong型
VBA7 32Bit は GettickcountとなりPtrsafeをつけてLong型ここがLongPtrではないのもポイント
VBA6以前の 32Bit は GettickcountとなりLong型

変数の宣言でも場合分けが必要なので、Typeで宣言する

上記のことから、Typeで場合分けをする
Typeで型宣言をすると楽なので
最初と途中と最後というように宣言しておく。

使う時も場合分けをする

代入する関数名が異なるので、プロシージャ内でも場合分けをする。

とても使いづらいので、Classを使うとすっきりした

コード Classモジュールを使用して、標準モジュールを軽くする

Mougのコードから64/32Bit共通にして、さらにClassModle化し、32Bit時代のシンプルさを取り戻したようには見える。
Win64 Win32 共用化は標準モジュールだけではなくClassModuleも必要なようだ。

標準モジュールのコード

Sub GettickSample()
'標準モジュール用
'https://www.moug.net/tech/acvba/0020033.html
Dim gtTickcntClass As GetTickCountClass: Set gtTickcntClass = New GetTickCountClass 'GetTickCountClassクラスモジュールの宣言と初期化
Debug.Print gtTickcntClass.GetValueOfTickCnt / 1000

Debug.Print gtTickcntClass.GetValueOfTickCnt  / 1000
End Sub

VBA Class Module クラスモジュール

 Class Module Name GetTickCountClass
' これはクラスモジュール用です。標準モジュールでは動きません
' VBE で 挿入(I)からクラスモジュールを選択して、クラスモジュールを作成し、コピーしてください。
' また他の標準モジュールやクラスモジュールにGettickcountを置かないでください
' VBE エディターでF4キーでプロパティウィンドウを表示し (オブジェクト名)を半角で
' GetTickCountClass
' としてください。Class名が違うと標準モジュールのサンプルは稼働しません。
' すべてのOffice Applicationで有効です
' VBA7 VBA6　64/32bit共用です
' マシンを立ち上げてからの時間を長整数型類で示し、プログラムの各段階で経過時間を表示させることで、そのアルゴリズムがどれくらい時間がかかるのか計測します。
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetTickCount64 Lib "kernel32" () As LongLong
#Else
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#End If
#Else
Private Declare Function GetTickCount Lib "kernel32" () As Long
#End If

'''VBA Class Module クラスモジュール
''Class Module Name GetTickCountClass
'''VBE エディターでF4キーでプロパティウィンドウを表示し (オブジェクト名)を半角で
' GetTickCountClass
' としてください。Class名が違うと標準モジュールのサンプルは稼働しません。

'''------アクセサ------------------------------------------
Property Get GetValueOfTickCnt()
#If VBA7 Then
#If Win64 Then
GetValueOfTickCnt = CLngLng(GetTickCount64)
#Else
GetValueOfTickCnt = CLngPtr(GetTickCount)
#End If
#Else
GetValueOfTickCnt = CLng(GetTickCount)
#End If
End Property


''標準モジュール用サンプル
'Sub GettickSample()
''標準モジュール用
''https://www.moug.net/tech/acvba/0020033.html
'Dim gtTickcntClass As GetTickCountClass: Set gtTickcntClass = New GetTickCountClass 'GetTickCountClassクラスモジュールの宣言と初期化
'Debug.Print gtTickcntClass.GetValueOfTickCnt /1000
'
'Debug.Print gtTickcntClass.GetValueOfTickCnt / 1000
'End Sub