【EXCEL】VBA-マクロのパスワード解除方法【コード有】

非表示にできる< 目次 >

VBA-マクロのパスワード解除とは？（VBAProjectパスワードのこと）

マクロのパスワード解除とは、「VBAProject パスワード」の解除って意味ですね。

VBA開発者が、何かしらの理由でパスワードを付けている状態です。

Nakamura

↓の画像で、赤枠で囲ってあるパスワード解除方法について、本記事では触れていきます。

簡単ですので、ちゃちゃっとやっていきましょう。

VBA開発者でも、たまに忘れちゃいますよね。笑

Nakamura

本記事でできること

本記事で紹介するコードでは、以下のことができます。

本記事で出来ること

EXCEL-VBAのVBAProjectパスワードを解除することができる。

基本コピペでOK。
使い方がやや特殊です。
そのため使用方法も記載しましたので併せて読んでおきましょう。

Nakamura

VBA-ユースケース

ユースケースは、主に3点かな、と。

ユースケース-3例

VBAツールを引き継いだが、PWロックされているためメンテナンスが出来ない
過去に開発した自作VBAツールのPWを忘れてしまった！
なんかしらの理由でVBAコード見たい

僕は、開発したVBAを利用者に渡すときに問題の切り分けができるように、
VBAにPWを付けて利用者に渡しています。

たまに、利用者がマクロに独自コードを加えるケースがあるんですよね。
それでエラーが発生した時に、
自己解決してくれるなら良いんですけど、
大体はVBA開発者に手戻りが発生するんですよね。。。

だから、「自分のコードが悪さをしている」と断定できるように、
パスワードをつけるようにしています。

Nakamura

VBA-使用時の注意点

EXCEL VBAのパスワード解除は、開発者の「何かしらの意図」があって施されたものです。

よって、本コード利用者はすべて自己責任で対応ください。

この記事は、開発者が読んでいることを信じます。笑

Nakamura

VBA-PW解除コードの紹介（※コピペでOK）

EXCELのバージョンによって、使用するコードが若干異なります。

違う箇所は、変数の部分ですね。
64bit版だとlongptrという変数を使用しています。

Nakamura

どちらのコードも試してみて、大丈夫な方を使えば良いかと。笑
緩い感じですみません。

Nakamura

◆EXCEL-32bit版はコチラ

Public Const PAGE_EXECUTE_READWRITE = &H40
 
Public Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
Public Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
Public Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Public Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim projectFunction As Long
Dim Flag As Boolean
 
Public Function GetPtr(ByVal Value As LongPtr) As LongPtr
  GetPtr = Value
End Function
 
Public Sub RecoverBytes()
  If Flag Then MoveMemory ByVal projectFunction, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function MyDialogBoxParamater(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
  If pTemplateName = 4070 Then
    MyDialogBoxParamater = 1
  Else
    RecoverBytes
    MyDialogBoxParamater = MyDialogBoxParamater(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)
    HookFlag
  End If
End Function
 
Public Function HookFlag() As Boolean
  Dim TmpBytes(0 To 5) As Byte
  Dim p As Long
  Dim OriginProtect As Long
 
  HookFlag = False
  projectFunction = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
  If VirtualProtect(ByVal projectFunction, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal projectFunction, 6
    If TmpBytes(0) <> &H68 Then
      MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal projectFunction, 6
      p = GetPtr(AddressOf MyDialogBoxParamater)
      HookBytes(0) = &H68
      MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
      HookBytes(5) = &HC3
      MoveMemory ByVal projectFunction, ByVal VarPtr(HookBytes(0)), 6
      Flag = True
      HookFlag = True
    End If
  End If
End Function
 
 
Sub VBAProjectパスワード解除()
  If HookFlag Then
    MsgBox "VBA Project を解除しました。", vbInformation, "成功しました。"
  End If
End Sub

Public Const PAGE_EXECUTE_READWRITE = &H40

Public Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)

Public Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr

Public Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr

Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr

Public Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

Dim HookBytes(0 To 5) As Byte

Dim OriginBytes(0 To 5) As Byte

Dim projectFunction As Long

Dim Flag As Boolean

Public Function GetPtr(ByVal Value As LongPtr) As LongPtr

GetPtr = Value

End Function

Public Sub RecoverBytes()

If Flag Then MoveMemory ByVal projectFunction, ByVal VarPtr(OriginBytes(0)), 6

End Sub

Public Function MyDialogBoxParamater(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

If pTemplateName = 4070 Then

MyDialogBoxParamater = 1

Else

RecoverBytes

MyDialogBoxParamater = MyDialogBoxParamater(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)

HookFlag

End If

End Function

Public Function HookFlag() As Boolean

Dim TmpBytes(0 To 5) As Byte

Dim p As Long

Dim OriginProtect As Long

HookFlag = False

projectFunction = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

If VirtualProtect(ByVal projectFunction, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal projectFunction, 6

If TmpBytes(0) <> &H68 Then

MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal projectFunction, 6

p = GetPtr(AddressOf MyDialogBoxParamater)

HookBytes(0) = &H68

MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4

HookBytes(5) = &HC3

MoveMemory ByVal projectFunction, ByVal VarPtr(HookBytes(0)), 6

Flag = True

HookFlag = True

End If

End Function

Sub VBAProjectパスワード解除()

If HookFlag Then

MsgBox "VBA Project を解除しました。", vbInformation, "成功しました。"

End If

End Sub

◆EXCEL-64bit版はコチラ

Public Const PAGE_EXECUTE_READWRITE = &H40
 
Public Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)
Public Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr
Public Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr
Public Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim projectFunction As LongPtr
Dim Flag As Boolean
 
Public Function GetPtr(ByVal Value As LongPtr) As LongPtr
  GetPtr = Value
End Function
 
Public Sub RecoverBytes()
  If Flag Then MoveMemory ByVal projectFunction, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function MyDialogBoxParamater(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer
  If pTemplateName = 4070 Then
    MyDialogBoxParamater = 1
  Else
    RecoverBytes
    MyDialogBoxParamater = MyDialogBoxParamater(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam)
    HookFlag
  End If
End Function
 
Public Function HookFlag() As Boolean
  Dim TmpBytes(0 To 5) As Byte
  Dim p As LongPtr
  Dim OriginProtect As LongPtr
 
  HookFlag = False
  projectFunction = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
  If VirtualProtect(ByVal projectFunction, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then
    MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal projectFunction, 6
    If TmpBytes(0) <> &H68 Then
      MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal projectFunction, 6
      p = GetPtr(AddressOf MyDialogBoxParamater)
      HookBytes(0) = &H68
      MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
      HookBytes(5) = &HC3
      MoveMemory ByVal projectFunction, ByVal VarPtr(HookBytes(0)), 6
      Flag = True
      HookFlag = True
    End If
  End If
End Function
 
 
Sub VBAProjectパスワード解除()
  If HookFlag Then
    MsgBox "VBA Project を解除しました。", vbInformation, "成功しました。"
  End If
End Sub

Public Const PAGE_EXECUTE_READWRITE = &H40

Public Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)

Public Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr

Public Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr

Public Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr

Dim HookBytes(0 To 5) As Byte

Dim OriginBytes(0 To 5) As Byte

Dim projectFunction As LongPtr

Dim Flag As Boolean

Public Function GetPtr(ByVal Value As LongPtr) As LongPtr

GetPtr = Value

End Function

Public Sub RecoverBytes()

If Flag Then MoveMemory ByVal projectFunction, ByVal VarPtr(OriginBytes(0)), 6

End Sub

Public Function MyDialogBoxParamater(ByVal hInstance As LongPtr, ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

If pTemplateName = 4070 Then

MyDialogBoxParamater = 1

Else

RecoverBytes