S
sylvain
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
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