Bonjour tout le monde.
Tout d'abord une bonne et heureuse année 2008 à tous.
Le problème qui m'amène aujourd'hui est le suivant :
je dispose d'une base de fichier Excel ( une 100 enivrions) que je consilde par macro.
Tous ces fichiers étant destiné à une utilisation externe j'ai protégé le classeur et les macros qu'elles contenaient. Le projet VBA est donc verrouillé par mot de passe.
je souhaiterais aujourd'hui supprimer le mot de passe pour l'accès au code VBA sur tous mes fichiers.
J'ai fait quelques recherches et je suis finalement arrivé au code suivant.
Malheureusement, il ne marche que pour le premier fichier de la liste et j'ai du mal a comprendre pourquoi.
Est-ce que quelqu'un pourrait m'aider.
D'avance merci
Tout d'abord une bonne et heureuse année 2008 à tous.
Le problème qui m'amène aujourd'hui est le suivant :
je dispose d'une base de fichier Excel ( une 100 enivrions) que je consilde par macro.
Tous ces fichiers étant destiné à une utilisation externe j'ai protégé le classeur et les macros qu'elles contenaient. Le projet VBA est donc verrouillé par mot de passe.
je souhaiterais aujourd'hui supprimer le mot de passe pour l'accès au code VBA sur tous mes fichiers.
J'ai fait quelques recherches et je suis finalement arrivé au code suivant.
Malheureusement, il ne marche que pour le premier fichier de la liste et j'ai du mal a comprendre pourquoi.
Est-ce que quelqu'un pourrait m'aider.
D'avance merci
Code:
/
Option Explicit
Private Declare Function FindWindowA Lib "User32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetForegroundWindow Lib "User32" () As Long
Private Declare Function SetForegroundWindow Lib "User32" (ByVal hWnd As Long) As Long
Public classeur As String
Public i As Integer
Public Wb As Workbook
Public x As Workbook
Function Déprotège(classeur As String, MdP As String) As Boolean
Dim XLhWnd As Long, VBEhWnd As Long, CurhWnd As Long
Dim Wbk As Workbook
On Error Resume Next
Set Wbk = Workbooks(Dir$(classeur))
On Error GoTo Fin
If Not Wbk Is Nothing Then
If UCase$(Wbk.FullName) <> UCase$(classeur) Then Exit Function
If Not Wbk.Saved Then Wbk.Save
End If
If Not ActiveWorkbook Is Wbk Then Set Wbk = ActiveWorkbook
CurhWnd = GetForegroundWindow
XLhWnd = FindWindowA("XLMAIN", Application.Caption)
With Application.VBE
VBEhWnd = FindWindowA("wndclass_desked_gsk", .MainWindow.Caption)
If CurhWnd = XLhWnd Then SetForegroundWindow VBEhWnd
.CommandBars.FindControl(ID:=2557).Execute
If ActiveWorkbook.VBProject.Protection = 1 Then
SendKeys "~" & MdP & "~", True
.ActiveCodePane.Window.Close
End If
End With
Wbk.Activate
SetForegroundWindow CurhWnd
Déprotège = True
Exit Function
Fin:
End Function
Sub deprotection_systematique()
Set Wb = ThisWorkbook
With Application.FileSearch
.NewSearch
.LookIn = Wb.Path
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
.Execute
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> Wb.FullName Then
Set x = Workbooks.Open(.FoundFiles(i), True, , , , , , , , , , , False)
classeur = x.FullName
Call Déprotège(classeur, "monmotdepasse")
x.Close SaveChanges:=True
End If
Next i
End With
End Sub
/[Code]
Dernière édition: