ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   protect / unprotect VBA project by macro (https://www.excelbanter.com/excel-discussion-misc-queries/102273-protect-unprotect-vba-project-macro.html)

sylvain

protect / unprotect VBA project by macro
 
Hello everybody,

I'm interested by setting-up / unsetting a password protection of
my VBA project by macro, but it doesn't seem to be easy.

I know that I can test the protection mode using :
Application.ActiveVBProject.Protection
= 0 (vbext_pp_none) if not protected
= 1 (vbext_pp_locked) if protected

But how setting-up the protection ?
The problem is to use the SendKeys method with the appropriate windows.

I tried unsuccessfully many ways, see below, and any help is granted.
Thanks in advance,
sylvain

-------------

Sub UnlockedVBAProject()

If Val(Application.Version) 8 Then
SendKeys _
"%{F11}%xi+{TAB}{RIGHT}{TAB} {TAB}" & _
"{BACKSPACE}{TAB}{BACKSPACE}{TAB}{ENTER}%{q}"
End If
End Sub


Sub LockedVBAProject()
If Val(Application.Version) 8 Then
SendKeys _
"%{F11}%xi+{TAB}{RIGHT}{TAB} {TAB}" & _
PASSWORD & "{TAB}" & "spi2006" & "{TAB}{ENTER}%{q}"
End If
End Sub

-------------

Sub DeprotegerProjetVB3()

Dim XLhWnd As Long, VBEhWnd As Long, CurhWnd As Long
Dim Wbk As Workbook

Dim Classeur As String
Const MdP As String = PASSWORD

Classeur = ActiveWorkbook.FullName

On Error Resume Next
Set Wbk = Workbooks(Dir$(Classeur))
On Error GoTo Fin
If Not Wbk Is Nothing Then
If Wbk.FullName < Classeur Then Exit Sub
If Not Wbk.Saved Then Wbk.Save
Else: Application.ScreenUpdating = False
End If

CurhWnd = GetForegroundWindow
XLhWnd = FindWindowA(vbNullString, Application.Caption)

With Application.VBE
VBEhWnd = FindWindowA(vbNullString, .MainWindow.Caption)
If CurhWnd = XLhWnd Then SetForegroundWindow VBEhWnd
.CommandBars.FindControl(ID:=2557).Execute
' NE PAS EFFACER, même si le classeur est déjà ouvert !!!!!!
'Workbooks.Open Classeur
If ActiveWorkbook.VBProject.Protection = 1 Then
SendKeys "~" & MdP & "~", True
.ActiveCodePane.Window.Close
End If
End With

SetForegroundWindow CurhWnd
' Déprotège = True
Exit Sub

Fin:
End Sub


All times are GMT +1. The time now is 10:58 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com