Creation d'un mot de pass automatique + protection de fichier

Bonjour a tous

J'exporte des onglets clients de mon fichier "maitre" dans un dossier (creation d'un fichier xlsx ) ayant le nom de mon onglet

Idem pour l'import... j'appelle le fichier, recupere l'onglet puis ferme le fichier

je cherche a automatiser les mots de pass (via macro) lors de l'export et de l'import car ce sont des fichier a données dites sensible et je ne veux pas que les Mdp soient identique.

Pour l'export, celui ci serait composer par exemple de "Nom du fichier maitre/Nom onglet Exporter" (Programmation aléatoire/C00025)

Pour l'import, celui ci serait composer par exemple de "Nom du fichier maitre/Nom dossier a importer" (Programmation aléatoire/C00025)

Export
    Sheets(sh).Move
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:= _
        Dossier & SSDossier & nomfichier & ".xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.Close True

Import
Set wb = Workbooks.Open(Dossier & "Clients/" & codeclient & ".xlsx") 'ouvre le fichier client
    If wb Is Nothing Then MsgBox "La fiche client doit être archivé": Exit Sub 'fichier n'est pas ouvert >>> message

ActiveSheet.Copy Before:=Workbooks(Fichier).Sheets(1)

je ne vois pas comment crée cet macro Protect et unprotect qui pendrait en compte mes parametres et je ne vois pas non plus ou la placer

merci de votre aide

re,

Je viens de crée 2 macros fonctionnel pour la creation du Mdp...

Sub PasswordCreat()
Dim Wb As String
Dim Ws As String

Wb = ThisWorkbook.Name
Ws = ActiveSheet.Name

Wb = Split(Wb, ".")(0) 'supprimer l'extension de fichier
Wb = Replace(Wb, " ", "") 'supprimer les espaces dans le nom du fichier

'MsgBox Wb & "/" & Ws

End Sub

Sub PasswordImport()
Dim Wb2 As String '
Dim Wbi As String

Wb2 = ThisWorkbook.Name 'nom du dernier fichier ouvert     C00001
Wbi = Fichier           ' nom du fichier principal en Const ( a nettoyer)

Wb2 = Split(Wb2, ".")(0) 'supprimer l'extension de fichier

Wbi = Split(Wbi, ".")(0) 'supprimer l'extension de fichier
Wbi = Replace(Wbi, " ", "") 'supprimer les espaces dans le nom du fichier

'MsgBox Wbi & "/" & Wb2

End Sub

mais comment recuperer ce résultat puis comment l’intégrer a

.Protect Password:="PasswordCreat", DrawingObjects:=True, Contents:=True, Scenarios:=True

.Unprotect Password:="PasswordImport"

Salut,

Je n'ai pas regarder de plus près tes codes mais tu peux transformer les Sub en Fonctions et les appeler ensuite.

Function PasswordCreat()
Dim Wb As String
Dim Ws As String

Wb = ThisWorkbook.Name
Ws = ActiveSheet.Name

Wb = Split(Wb, ".")(0) 'supprimer l'extension de fichier
Wb = Replace(Wb, " ", "") 'supprimer les espaces dans le nom du fichier

PasswordCreat Wb & "/" & Ws
End Function

Function PasswordImport()
Dim Wb2 As String '
Dim Wbi As String

Wb2 = ThisWorkbook.Name 'nom du dernier fichier ouvert     C00001
Wbi = Fichier           ' nom du fichier principal en Const ( a nettoyer)

Wb2 = Split(Wb2, ".")(0) 'supprimer l'extension de fichier

Wbi = Split(Wbi, ".")(0) 'supprimer l'extension de fichier
Wbi = Replace(Wbi, " ", "") 'supprimer les espaces dans le nom du fichier

PasswordImport Wbi & "/" & Wb2

End Function

et pour l'appel (Ne pas mettre les guillemets)

.Protect Password:=PasswordCreat, DrawingObjects:=True, Contents:=True, Scenarios:=True

.Unprotect Password:=PasswordImport

mon . protect n'est pas la bonne solution... ca ne verrouille que les cellule et pas l'ouverture..

je cherche a chiffrer avec un mot de passe ( ndrl Fichier / Information )

des idées ???

Ps Merci de ta reponse @Jean-Paul

Salut,

C'est presque pareil il te faut juste utiliser le classeur en lieu et place des feuilles

Sub WorkbookProtect()
ActiveWorkbook.Protect PasswordCreat
ActiveWorkbook.Save

End Sub

Bonjour Jean Paul

la protection du classeur ne verrouille pas l'acces au dossier mais juste la modification... la consultation des données reste disponible.

j'ai trouvé cela... reste à l'adapter et à tester...

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim chemin$, nomfich$
chemin = Me.Path & "\" 'à adapter
nomfich = Me.Name 'ou un autre nom
'---cryptage---
Me.SetPasswordEncryptionOptions PasswordEncryptionProvider:= _
  "Microsoft Strong Cryptographic Provider", PasswordEncryptionAlgorithm:="RC4", _
    PasswordEncryptionKeyLength:=128, PasswordEncryptionFileProperties:=True
'---enregistrement avec mot de passe---
Application.DisplayAlerts = False
Me.SaveAs chemin & nomfich, FileFormat:=Me.FileFormat, Password:="test"
End Sub

si quelqu'un connait...

Salut,

Je pense qu'avec le précédent post tu aurais pu t'en sortir, tu adaptes chemin, nomfichier; et tu remplaces Password:="test" par Password:=PasswordCreat.

tu peux aussi passer par une variable intermédiaire

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim chemin$, nomfich$
Dim strTemp as string
chemin = Me.Path & "\" 'à adapter
nomfich = Me.Name 'ou un autre nom
strTemp = PasswordCreat
'---cryptage---
Me.SetPasswordEncryptionOptions PasswordEncryptionProvider:= _
  "Microsoft Strong Cryptographic Provider", PasswordEncryptionAlgorithm:="RC4", _
    PasswordEncryptionKeyLength:=128, PasswordEncryptionFileProperties:=True
'---enregistrement avec mot de passe---
Application.DisplayAlerts = False
Me.SaveAs chemin & nomfich, FileFormat:=Me.FileFormat, Password:=strTemp
End Sub

Encore une fois je n'ai pas tester ce code...

Bonne prog

impecc, merci beaucoup Jean Paul