ExcelVBAのプロジェクトのプロパティでパスワードをかける

modPass.bas

Option Explicit
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWndParent As Long, _
    ByVal hWndChildAfter As Long, _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
Private Declare Function SetTimer Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal nIDEvent As Long, _
    ByVal uElapse As Long, _
    ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal uIDEvent As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Const WM_SETTEXT = &HC
Private Const WM_SETFOCUS = &H7
Private Const BM_CLICK = &HF5
Private Const BM_SETCHECK = &HF1
Private Const BST_CHECKED = &H1
Private Const WM_ACTIVATE = &H6
Private Const WM_CHAR = &H102
Private Const TCM_SETCURFOCUS = &H1330
Private strPass As String
' /////////////////////////////////////////////////////////////////////////////////////
' //テストプロシージャ testAddPass
' /////////////////////////////////////////////////////////////////////////////////////
Private Sub testAddPass()
    strPass = "ABCDEFG"
    
    'シート非表示
    Workbooks("Book1").VBProject.VBComponents("Sheet1").Properties("Visible") = xlSheetVeryHidden
    
    'VBEパスワードをかける
    AddPass Workbooks("Book1")
    
End Sub
' /////////////////////////////////////////////////////////////////////////////////////
' //#名称 AddPass
' //
' //#概要 指定のブックのVBAProjectにプロテクトをかける
' //
' //#引数 wbk[Workbook]:パスワードをかけるブック
' //
' //#戻値 無し
' //
' //#解説 先にSetTimerでプロジェクトのプロパティダイアログが見つかったらパスワードを
' //      かけるプロシージャを走らせておいてからダイアログを表示する。
' //
' //#履歴 2014/02/28
' //      Coded by YASUTADA OOBA
' //
' /////////////////////////////////////////////////////////////////////////////////////
Private Sub AddPass(wbk As Workbook)

    Dim vbp As VBProject
    Dim lngInterval As Long
    Dim lngTimerID As Long
    
    lngInterval = 100
        
    wbk.VBProject.VBComponents(1).CodeModule.CodePane.Show
    lngTimerID = SetTimer(0, 0, lngInterval, AddressOf TProc)
    
    Application.VBE.CommandBars("Project Window").Controls("VBAProject のプロパティ(&E)...").Execute
    
End Sub
' /////////////////////////////////////////////////////////////////////////////////////
' //#名称 TProc
' //
' //#概要
' //
' //#引数 ByVal hwnd[Long]:
' //      ByVal uMsg[Long]:
' //      ByVal idEvent[Long]:
' //      ByVal dwTime[Long]:
' //
' //#戻値 無し
' //
' //#解説 SetTimerで呼び出されるプロシージャ。プロジェクトのプロパティダイアログを操作して
' //      パスワードを設定する
' //
' //#履歴 2014/02/28
' //      Coded by YASUTADA OOBA
' //
' /////////////////////////////////////////////////////////////////////////////////////
Private Sub TProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    
    Dim vbphWnd As Long
    Dim tabhWnd As Long
    Dim dlghWnd As Long
    Dim chkhWnd As Long
    
    Dim edhWnd As Long
    Dim i As Long
    Dim btnhWnd As Long

    'プロジェクトのプロパティダイアログの検索
    Do Until vbphWnd <> 0
        vbphWnd = FindWindowEx(0, 0, "#32770", "VBAProject - プロジェクト プロパティ")
        Sleep 200
    Loop
    
    'タブの切り替え
    tabhWnd = FindWindowEx(vbphWnd, 0, "SysTabControl32", "")
    SendMessage tabhWnd, TCM_SETCURFOCUS, 1, 0

    'タブ切り替え後に取得できるタブの中身の取得
    dlghWnd = FindWindowEx(vbphWnd, 0, "#32770", "")
    
    'タブの中身の中でプロジェクトのロックチェックボックスをオン
    chkhWnd = FindWindowEx(dlghWnd, 0, "Button", "プロジェクトを表示用にロックする(&V)")
    SendMessage chkhWnd, BM_SETCHECK, BST_CHECKED, 0
    
    'タブの中身の中でパス入力テキストボックスの取得と入力
    edhWnd = FindWindowEx(dlghWnd, 0, "Edit", "")
    SendMessage edhWnd, WM_SETFOCUS, 0, 0
    For i = 1 To Len(strPass)
        SendMessage edhWnd, WM_CHAR, Asc(Mid(strPass, i, 1)), ByVal 0
    Next i

    '2番目のパス入力ボックスの取得と入力
    edhWnd = FindWindowEx(dlghWnd, edhWnd, "Edit", "")
    SendMessage edhWnd, WM_SETFOCUS, 0, 0
    For i = 1 To Len(strPass)
        SendMessage edhWnd, WM_CHAR, Asc(Mid(strPass, i, 1)), ByVal 0
    Next i
    
    'OKボタンの取得と押下
    btnhWnd = FindWindowEx(vbphWnd, 0, "Button", "OK")
    SendMessage btnhWnd, BM_CLICK, 0, 0
    
    KillTimer 0, idEvent
    
End Sub