Sub DeprotegerProjetVBA()
Dim NomClasseur As String
If Application.VBE.ActiveVBProject.Protection <> 0 Then
NomClasseur = ThisWorkbook.Path & "\FichierTemp.xls"
Workbooks.Open Filename:=NomClasseur
Application.Run "'FichierTemp.xls'!Sample"
Workbooks("FichierTemp.xls").Close SaveChanges:=False
End If
End Sub
Sub Procedure()
Application.ScreenUpdating = False
If Application.VBE.ActiveVBProject.Protection <> 0 Then
Call CreerClasseur
Call DeprotegerProjetVBA
Call SupprimerClasseur
End If
Application.ScreenUpdating = True
End Sub
Sub SupprimerClasseur()
Dim chemin As String, nf As String
nf = ThisWorkbook.Path & "\FichierTemp.xls"
chemin = Dir(nf)
If chemin <> "" Then Kill (nf)
End Sub
Sub CreerClasseur()
Dim xlBook As Workbook
Dim xlModule As Object, i As Long
Application.DisplayAlerts = False
Set xlBook = Workbooks.Add
Set xlModule = xlBook.VBProject.VBComponents.Add(1)
With xlModule.CodeModule
i = .CountOfLines
.InsertLines i, "Sub Sample()": i = i + 1
.InsertLines i, "UnprotecPassword Workbooks(""Unprotect_VBA_Project.xls""), ""do""": i = i + 1
.InsertLines i, "End Sub": i = i + 1
.InsertLines i, "Sub UnprotecPassword(wb As Workbook, ByVal projectPassword As String)": i = i + 1
.InsertLines i, "Dim currentActiveWb As Workbook": i = i + 1
.InsertLines i, "If wb.VBProject.Protection <> 1 Then": i = i + 1
.InsertLines i, "Exit Sub": i = i + 1
.InsertLines i, "End If": i = i + 1
.InsertLines i, "Set currentActiveWb = ActiveWorkbook": i = i + 1
.InsertLines i, "wb.Activate": i = i + 1
.InsertLines i, "SendKeys ""^r""": i = i + 1
.InsertLines i, "SendKeys ""{TAB}""": i = i + 1
.InsertLines i, "SendKeys ""~""": i = i + 1
.InsertLines i, "SendKeys projectPassword": i = i + 1
.InsertLines i, "SendKeys ""~""": i = i + 1
.InsertLines i, "SendKeys ""{NUMLOCK}""": i = i + 1
.InsertLines i, "If (wb.VBProject.Protection = 0) Then": i = i + 1
.InsertLines i, "MsgBox (""failed to unlock"")": i = i + 1
.InsertLines i, "End If": i = i + 1
.InsertLines i, "currentActiveWb.Activate": i = i + 1
.InsertLines i, "End Sub": i = i + 1
End With
xlBook.SaveAs Filename:= _
ThisWorkbook.Path & "\FichierTemp.xls", FileFormat:=xlExcel8 _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
xlBook.Close SaveChanges:=True
Application.DisplayAlerts = True
End Sub