[Macro] pour ajouter un mot de passe à un fichier Excel

Bonjour,

J'ai trois fichiers Excel de type xlsx:

A.xlsx

B.xlsx

C.xlsx

je voudrais avec une macro en vba d'un fichier mdp.xlsm protéger mes 3 fichiers xlsx qui n'ont pas de mot de passe

par des mot de passe différents puis les sauvegarder avec les meme noms dans le meme répertoire.

Merci par avance.

Jack

Bonjour,

Pour être certain de bien comprendre, tu veux protéger le classeur à l'ouverture ou protéger une feuille spécifique des classeurs ?

Dans l'attente j'ai bricolé quelque chose qui semble répondre à ton besoin :

Dans le fichier Excel ci-joint, tu trouveras un utilitaire maison dans lequel tu pourras sélectionner un classeur Excel ou écrire l'URL directement dans le champ (2 vérifications sont faites : si l'URL du fichier est valide et si le fichier n'est pas déjà protégé en écriture). Puis tu pourras définir un mot de passe (1 vérification est faire : si les deux mots de passes sont identiques). Si tout est conforme, le fichier sélectionné est enregistré avec la protection.

L'option "Proposer l'ouverture en lecture seule" permet (si elle est cochée), une ouverture en lecture seule du fichier après protection, le mot de passe sera demandé pour ouvrir le fichier en écriture). Dans le cas contraire il est obligé de saisir le mot de passe pour afficher et modifier le fichier.

Bonjour GGautier,

Je voudrais proteger le classeur complet donc proteger le classeur a l'ouverture.

Merci pour ton fichier xlsm mais ce n'est pas comme cela que je voulais proceder. Neanmoins c'est du beau travail. BRAVO.

Je voudrais tout simplement en executant un macro, que mes 3 fichiers soit proteger par un mot de passe a l'ouverture. sachant que ces 3 fichiers non aucun mdp.

Je definirais les 3 mots de passe differents de chaque fichier dans le macro directement.

Est ce possible?

Merci
Jack

Bonjour,

Dans ce cas il faut se renseigner sur la méthode Workbook.SaveAs. Je te propose un code ci-dessous. Est-ce que cela correspond à ton besoin ?

Sub Protect()
Dim Wb As Workbook
Dim Wb1URL As String, Wb2URL As String, Wb3URL As String
Dim Wb1Mdp As String, Wb2Mdp As String, Wb3Mdp As String

    On Error GoTo ErrorProtect

    Wb1URL = "C:.....\Classeur1.xlsx"
    Wb2URL = "C:.....\Classeur2.xlsx"
    Wb3URL = "C:.....\Classeur3.xlsx"

    Wb1Mdp = "Mot de passe 1"
    Wb2Mdp = "Un autre MDP"
    Wb3Mdp = "Coucou"

    Application.ScreenUpdating = False
    Set Wb = Application.Workbooks.Open(Wb1URL): Wb.SaveAs Wb1URL, , Wb1Mdp: Wb.Close: Set Wb = Nothing
    Set Wb = Application.Workbooks.Open(Wb2URL): Wb.SaveAs Wb2URL, , Wb2Mdp: Wb.Close: Set Wb = Nothing
    Set Wb = Application.Workbooks.Open(Wb3URL): Wb.SaveAs Wb3URL, , Wb3Mdp: Wb.Close: Set Wb = Nothing
    Application.ScreenUpdating = True

Exit Sub
ErrorProtect:
Application.ScreenUpdating = True
MsgBox "Une erreur est survenue pendant le processus de protection des classeurs.", vbCritical
End Sub

Genial. Ca marche.

J'ai un seul soucis:

A chaque fois il me demande de remplacer le fichier dans le repertoire et je dois ecrire oui.

peut on enlever les 3 notifications?

merci

Peut-être avec Application.DisplayAlerts = False ?

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Wb = Application.Workbooks.Open(Wb1URL): Wb.SaveAs Wb1URL, , Wb1Mdp: Wb.Close: Set Wb = Nothing
Set Wb = Application.Workbooks.Open(Wb2URL): Wb.SaveAs Wb2URL, , Wb2Mdp: Wb.Close: Set Wb = Nothing
Set Wb = Application.Workbooks.Open(Wb3URL): Wb.SaveAs Wb3URL, , Wb3Mdp: Wb.Close: Set Wb = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

Merci ca marche