Discussion :

[NEC14]

Merci Pierre pour ta patience et ton aide.

La touche F8 de mon clavier ne fonctionnant pas, je vais essayer avec F5

[NEC14]

Donc si je comprend bien le fonctionnement (que j'ai testé, et qui fonctionne dans ton fichier), je dois également supprimer tous les "mdp"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate()
ActiveSheet.Unprotect mdp
Dim An2 As Byte, N As Integer
An2 = DatePart("ww", Date, 2, 2)
An = Year(Now())
    Range("F3") = "CLAS" & "-" & "CHV" & "-" & An & "-" & An2
    ActiveSheet.Protect mdp, UserInterfaceOnly:=True
End Sub

[Pierre Fauconnier]

Mon code est proposé pour gérer la modification du mot de passe sur les feuilles.

Après, tu lances ce code à l'ouverture du fichier, à l'activation d'une feuille, par clic sur un bouton, ça n'a guère d'importance.

[NEC14]

D'accord merci Pierre.

Je vais étudier tout ça, tester dans mon fichier et je te tiens informé du résultat.
Désolé de t'avoir absorbé autant de temps.
J'ai les neurones très fatiguées en ce moment

[Pierre Fauconnier]

Si je réponds, c'est que cela ne me dérange pas...

[eriiic]

Bonjour,

tu as passé cette étape depuis un moment mais tu peux mettre ton mdp dans un nom caché plutôt que de monopoliser une feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Names.Add Name:="mdp", RefersTo:="mon_mot_de_passe", Visible:=False
MsgBox [mdp]

eric

[NEC14]

Bonjour le forum,

Je reviens vers vous pour donner suite à cette discussion. Après avoir mis en place le code proposé par Pierre, je rencontre quelques problèmes.

Lorsque je ferme le formulaire me permettant de modifier le mot de passe, rien ne se passe, l'ancien mot de passe n'est pas remplacé par le nouveau. J'ai pourtant bien suivi les recommandations qui m'ont été faites, alors je ne comprends pas.

Je vous mets le fichier en pièce jointe à toute fin utile (mot de passe du code "RLC")

Merci par avance pour votre aide

Echéanciers CLAS.xlsm

[NEC14]

Bonjour le forum,

J'ai tenté de chercher la solution hier soir mais sans succès. Je ne comprends pas pourquoi ça ne fonctionne pas. Je vais poursuivre mon investigation, si vous avez une idée à me soumettre, je l'accueillerai avec gratitude.
Merci par avance
Amicalement
René

[Pierre Fauconnier]

Il faudrait que tu donnes le code VBA que tu as utilisé. Sans cela, difficile de répondre (Mettre un fichier dont le projet VBA est modifié par mot de passe n'aide pas )

[NEC14]

Bonjour Pierre,

Voici le code lié au bouton qui sert à afficher le formulaire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Private Sub CommandButton1_Click()
Load usfPwd
usfPwd.Show
usfPwd.tboNewPwd.Text = ""
usfPwd.tboOldPwd.Text = ""
End Sub

Le code module qui permet de changer de mot de passe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
Option Explicit
 
Property Get Test() As String
  Test = "Bonjour"
End Property
 
Sub TestProtection()
  Debug.Print Feuil1.Protection Is Nothing
End Sub
 
Sub ChangePassWord(OldPwd As String, NewPwd As String)
  Dim ws As Worksheet
 
  For Each ws In ThisWorkbook.Worksheets
    If ws.ProtectContents Then
      ws.Unprotect OldPwd
      ws.Protect NewPwd, UserInterfaceOnly:=True
    End If
  Next
End Sub
 
 
Sub UpdatePassWords()
  Dim OldPwd As String, NewPwd As String
  Dim CurrentPwd As String
 
  usfPwd.Show
  OldPwd = usfPwd.tboOldPwd
  NewPwd = usfPwd.tboNewPwd
  Unload usfPwd
  CurrentPwd = Range("CurrentPassWord").Value
  If CurrentPwd = OldPwd Then
    ChangePassWord OldPwd, NewPwd
    Range("CurrentPassWord").Value = NewPwd
  Else
    MsgBox "L'ancien mot de passe saisi est incorrect", vbExclamation
  End If
End Sub

Le code lié à chacune des feuilles de calcul :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
Private Sub Worksheet_Activate() 'Ce code permet de mettre le début d'un numéro incrémenté
ActiveSheet.Unprotect
Dim An2 As Byte, N As Integer
An2 = DatePart("ww", Date, 2, 2)
An = Year(Now())
    Range("F3") = "CLAS" & "-" & "CHV" & "-" & An & "-" & An2
    ActiveSheet.Protect , UserInterfaceOnly:=True
End Sub
 
Private Sub Worksheet_Change(ByVal Target As Range) 'la suite du numéro incrémenté
ActiveSheet.Unprotect
If Not Application.Intersect(Target, Range("F15")) Is Nothing Then
If Range("F15") = "" Then
    N = Range("H3")
    N = N
    Range("H3") = N
    Else
    N = Range("H3")
    N = N + 1
    Range("H3") = N
End If
End If
    ActiveSheet.Protect , UserInterfaceOnly:=True
End Sub
 
Private Sub CmbValide_Click() 'copie des valeurs vers un tableau situé dans une autre feuille
Dim Lig As Long, DerLig As Long
Dim ShtS As Worksheet, ShtF As Worksheet
 
Set ShtS = Sheets("Chèques_vacances")
Set ShtF = Sheets("Rec_CV")
 
Application.ScreenUpdating = False
ShtF.Unprotect
 
DerLig = ShtF.Cells(Rows.Count, "A").End(xlUp).Row + 1
For Lig = 2 To DerLig
 
ShtF.Range("A" & DerLig) = ShtS.Range("F3").Value
ShtF.Range("B" & DerLig) = ShtS.Range("H3").Value
ShtF.Range("C" & DerLig) = ShtS.Range("F15").Value
ShtF.Range("D" & DerLig) = ShtS.Range("F13").Value
ShtF.Range("E" & DerLig) = ShtS.Range("F19").Value
ShtF.Range("F" & DerLig) = ShtS.Range("G19").Value
ShtF.Range("G" & DerLig) = ShtS.Range("H19").Value
ShtF.Range("H" & DerLig) = ShtS.Range("D23").Value
ShtF.Range("J" & DerLig) = ShtS.Range("B23").Value
ShtF.Range("K" & DerLig) = ShtS.Range("B32").Value
ShtF.Range("L" & DerLig) = ShtS.Range("F5").Value
ShtF.Range("M" & DerLig) = ShtS.Range("C36").Value
ShtF.Range("N" & DerLig) = ShtS.Range("F36").Value
Next Lig
ActiveWindow.SelectedSheets.PrintOut copies:=2, Collate:=True
ShtF.Protect , UserInterfaceOnly:=True
Application.ScreenUpdating = True
End Sub

[Invité]

Il faut. Le mettre dans ta fonction UpdatePassWords!
on ne teste que Err sa passe ou ça casse!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
on error resume next
ws.Unprotect OldPwd
If err then mesgbox "err"
On error toto 0

C'est exactement le code que je t'avais suggéré dans un autre poste avec en prime un fichier Excel! Mais je pense que je l'avais supprimer pour ne pas surcharger vue qu'a priori il semblerait incohérent avec le fils du poste!

[NEC14]

Bonjour et merci dysorthographie, mais où dois-je mettre ce code ?

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
on error resume next
ws.Unprotect usfPwd.tboOldPwd.Text 
If err then msgbox "err"
On error toto 0

En fait ton mot de passe marche ou il ne marche, pas inutile de le comparer le vrai teste il déverrouille ou pas!

Maintenant si tu veux comparer NewPass Confirm utilise instr bynarry commare

Instr("¥" & NewPass "¥","¥" & Confirm &"¥",binarrycompar)<>0 a la syntaxe près!

Le caractère ¥ permet de faire un teste sur le texte entier et nom.un fragment!

[NEC14]

Désolé, mais je ne comprends pas , j'ai le cerveau lent ce matin.

[Invité]

bien-sur il n'est pas tout à fait conforme à ta demande mais adaptable!

Code Module standard :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Property Get PassWord(Optional ByRef WS As Worksheet = Nothing, Optional Modifier As Boolean) As String
Static PSW As String
If Modifier = True Then PSW = UserForm1.Modifier(WS): Unload UserForm1
If PSW = "" Then PSW = UserForm1.Passe(WS): Unload UserForm1
PassWord = PSW
End Property
Sub test()
Debug.Print PassWord(Sheets(1), True)
Sheets(1).Unprotect PassWord
End Sub

Code UserForm :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Modtif As Boolean, Sh As Worksheet
 
 
 
Private Sub CommandButton1_Click()
If Me.TextBox1 = "" Then MsgBox "Vous devez": Exit Sub
 On Error Resume Next
   Sh.Unprotect TextBox1
   If Err Then MsgBox "Err Unprotect": On Error GoTo 0: Exit Sub
 Sh.Protect TextBox1
If Modtif = True And TextBox2 = "" Or (Modtif = True And TextBox2 <> TextBox3) Then
    MsgBox "Err Modif": Exit Sub
End If
If Modtif = True Then
   On Error Resume Next
   Sh.Unprotect TextBox1
   If Err Then MsgBox "Err Unprotect": On Error GoTo 0: Exit Sub
   Sh.Protect TextBox2
   On Error GoTo 0
End If
Me.Hide
 
 
End Sub
 
 
Public Function Passe(WS As Worksheet) As String
Set Sh = WS
Me.CommandButton1.Top = 16: Me.Height = 103: Me.Frame1.Visible = False
Me.Show vbModal
Passe = Me.TextBox1
 
 
End Function
 
 
Public Function Modifier(WS As Worksheet) As String
Modtif = True
Set Sh = WS
Me.Height = 144: Me.CommandButton1.Top = 90: Me.Frame1.Visible = True
Me.Show vbModal
Modifier = Me.TextBox2
End Function

[NEC14]

Avec ton exemple je comprends mieux. Je vais modifier mon projet et je te tiens au courant. Merci beaucoup

[NEC14]

J'ai testé ton fichier pour voir comment ça fonctionne, mais chez moi, le mot de passe ne change pas. J'ai pourtant enregistré ton fichier afin qu'il puisse accepter les macros.
Cela vient peut-être de ma version (Excel 2010)

[Invité]

ça marchait mai comme je modifiais le mot de passe!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub test()
Debug.Print PassWord(ThisWorkbook.Sheets(1), True)
End Sub

[NEC14]

Merci, ça marche mieux. Par contre dans la feuille1, case B1, le mot de passe lui ne change pas en fonction de ce qui est dans les TexBox ?
Comment est stocké le mot de passe ?
C'est pour mieux comprendre ton code

[Invité]

Version Sauvegarde Passe Word!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Property Get PassWord(Optional ByRef WS As Worksheet = Nothing, Optional Modifier As Boolean) As String
Static PSW As String:  'decriptage
If Modifier = True Then PSW = UserForm1.Modifier(WS): Unload UserForm1
If PSW <> CRYPTAGE(ThisWorkbook.Sheets("Feuil1").Range("C1"), "TEST", False) Then PSW = UserForm1.Passe(WS): Unload UserForm1
PassWord = PSW
End Property
Sub test()
'    Debug.Print CRYPTAGE(123, "tutu", True)
Debug.Print PassWord(ThisWorkbook.Sheets(1), True)
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub En_Mode_Vba_retrouve_pass_Word_Décript()
Debug.Print CRYPTAGE(ThisWorkbook.Sheets("Feuil1").Range("C1"), "TEST", False)
End Sub