そこそこ昔に作ったExcel VBAが実行できなくなっていたときの話(PtrSafeの話)

はじめに

約3年ぶりなので前説等長いと思いますので､
お急ぎの方は問題点のセクションまで飛ばしてください

背景

そこそこ昔(3年ぐらい前/2020年とか)まで更新していたExcel VBAを､
今の環境に持ってきて､実行しようとした際に何箇所か躓いたのでメモすることにした｡

VBAの内容

ものすごく簡単にいうとクイズアプリもどきを作成していた｡(非常に雑)
このときに使っていたコードの一部を流用するために､久しぶりに動作を確認しに来たのである｡

コードは以下のような構成である｡

黄色になっている部分が実際に使われていたフォームらしい
(なぜ使ってないフォームがあるかは察した｡)

イメージとしては､
Excelのテーブル上に､問題･選択肢･答え･画像データの情報を書いておき(quizlist)
configで問題数を調整し､startでユーザー用のUIを起動するランチャーの役割をしていた

フォームは
lancher→スタート→クイズ画面→ゴール→lancher(スペルこっちでは???launcher)
の順に遷移していた｡

参考として問題表示のコードを示す｡

Option Explicit
Public ans As Long, i As Long

Private Sub A_Click()
i = Worksheets("config").Cells(3, 2).Value
ans = 1
If ans = Worksheets("quizlist").Cells(1 + i, 8).Value Then
MsgBox "正解（いえーい）"
Worksheets("config").Cells(4, 2).Value = Worksheets("config").Cells(4, 2).Value + 1
Else
answrong
End If
 Worksheets("config").Cells(3, 2).Value = i + 1
load
End Sub

Private Sub B_Click()
i = Worksheets("config").Cells(3, 2).Value
ans = 2
If ans = Worksheets("quizlist").Cells(1 + i, 8).Value Then
MsgBox "正解（いえーい）"
Worksheets("config").Cells(4, 2).Value = Worksheets("config").Cells(4, 2).Value + 1
Else
answrong
End If
 Worksheets("config").Cells(3, 2).Value = i + 1
load
End Sub

Private Sub C_Click()
i = Worksheets("config").Cells(3, 2).Value
ans = 3
If ans = Worksheets("quizlist").Cells(1 + i, 8).Value Then
MsgBox "正解（いえーい）"
Worksheets("config").Cells(4, 2).Value = Worksheets("config").Cells(4, 2).Value + 1
Else
answrong
End If
 Worksheets("config").Cells(3, 2).Value = i + 1
load
End Sub

Private Sub D_Click()
i = Worksheets("config").Cells(3, 2).Value
ans = 4
If ans = Worksheets("quizlist").Cells(1 + i, 8).Value Then
MsgBox "正解（いえーい）"
Worksheets("config").Cells(4, 2).Value = Worksheets("config").Cells(4, 2).Value + 1
Else
answrong
End If
 Worksheets("config").Cells(3, 2).Value = i + 1
load
End Sub


Private Sub Label3_Click()
Stop
End Sub

Private Sub UserForm_Activate()
Application.WindowState = xlMaximized
With Me
.Width = Worksheets(3).Range("B1").Value
.Height = Worksheets(3).Range("B2").Value
End With
Worksheets("config").Cells(3, 2).Value = 1
load
End Sub
Sub answrong()
i = Worksheets("config").Cells(3, 2).Value
ans = Worksheets("quizlist").Cells(1 + i, 8).Value
Dim message As String, anst As String
anst = Worksheets("quizlist").Cells(1 + i, 3 + ans).Value
message = "残念（どよーん）。正解は" & anst & "でした"
MsgBox message
End Sub

Sub load()
i = Worksheets("config").Cells(3, 2).Value
If i <= Worksheets("config").Cells(6, 2).Value Then
Dim q As String, pic As String, file As String
file = ThisWorkbook.Path & "\"
q = Worksheets("quizlist").Cells(1 + i, 2).Value
pic = file & Worksheets("quizlist").Cells(1 + i, 3).Value
クイズ画面.問題.Caption = q


クイズ画面.画像.Picture = LoadPicture(pic)
クイズ画面.A.Caption = Worksheets("quizlist").Cells(1 + i, 4).Value
クイズ画面.B.Caption = Worksheets("quizlist").Cells(1 + i, 5).Value
クイズ画面.C.Caption = Worksheets("quizlist").Cells(1 + i, 6).Value
クイズ画面.D.Caption = Worksheets("quizlist").Cells(1 + i, 7).Value
Else
ゴール.Show (1)
End If
問題数.Caption = Worksheets("config").Cells(3, 2).Value
正解数.Caption = Worksheets("config").Cells(4, 2).Value
End Sub

今の自分が見ると､発狂しそうなコードであるが､今回用があるのは､

Dim q As String, pic As String, file As String
file = ThisWorkbook.Path & "\"
q = Worksheets("quizlist").Cells(1 + i, 2).Value
pic = file & Worksheets("quizlist").Cells(1 + i, 3).Value

クイズ画面.画像.Picture = LoadPicture(pic)

の画像読み込み部分である｡

ここの検証を行なうためにVBAを動かしていきたいと思った｡

問題点

実行にあたって2つの問題があった

1:そもそもマクロが無条件ブロックされる

セキュリティの都合でこうなっているが､
自分の書いたコードで自爆したら意味がわからないので､
とりあえず実行できるようにしたい

2:マクロが有効になっても下記のように怒られる｡

そもそも以前使っていたOfficeが32bitで有ることに衝撃を隠せない気もするが､
PtrSafeがなにかすらわからない状態である｡

解決方法

1はExcel上でとかの話しではなく､Explorer上で操作することで解決します｡

不明な発行元･信頼できない･自信のないマクロファイルでは絶対に許可してはいけません

方法としては至極単純で､
該当ファイルのプロパティを開くと､下にセキュリティの項目が表示されます｡

これを許可することで､実行可能になります｡(無論Excelの設定で警告はされます｡)

くどいようですが､

不明な発行元･信頼できない･自信のないマクロファイルでは絶対に許可してはいけません

2は使っているコードに問題があるようで､

Private Declare  Function GetForegroundWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long

の上のコードがエラーとなり下のコードが修正したあとのコードである｡
PtrSafeが今回の肝である｡

PtrSafeってなに?

詳しくは下記で確認いただければと思いますが､

簡単にいうと､64bit環境でVBA7の環境を使うには､
明示的に64bitでDeclare ステートメントを使うよって意味合いらしいです｡

そして､32bitでもつけっぱなしではOKでは無いらしく､
VBA7系かそれ以下かで分岐する必要があるらしいです

#If VBA7 Then 
Private Declare PtrSafe Function GetForegroundWindow Lib "user32" () As Long
#Else 
Private Declare  Function GetForegroundWindow Lib "user32" () As Long 
#EndIf

こんな感じで分岐が必要みたいです｡
(使う環境が混在しているので､あっちこっちでこれをしなければならないみたいで､
若干手間が拭えないです)

まとめ

• 64bitへ移行する際にはExcelVBAにも移行作業が必要になるんだとわかった
• 過去のコードを見直すとより良くしようがあるんだと思った

そんなところで無事コードを得たので､開発に戻るのであった｡

おわり