Macro VBA pour changer de mot de passe

Version imprimable

Voir 40 message(s) de cette discussion en une page

01/03/2018, 16h17
NEC14

Merci Pierre pour ta patience et ton aide. :ccool:

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

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:

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

01/03/2018, 16h32
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.
01/03/2018, 16h37
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
01/03/2018, 16h43
Pierre Fauconnier

Si je réponds, c'est que cela ne me dérange pas... ;)
03/03/2018, 15h55
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:

1 2 Names.Add Name:="mdp", RefersTo:="mon_mot_de_passe", Visible:=False MsgBox [mdp]
eric
12/03/2018, 12h32
NEC14

1 pièce(s) jointe(s)

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

Pièce jointe 359322
13/03/2018, 07h52
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é
13/03/2018, 07h56
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 ;) )

Bonjour Pierre,

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

Code:

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:

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:

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

13/03/2018, 08h18
Invité
Il faut. Le mettre dans ta fonction UpdatePassWords!
on ne teste que Err sa passe ou ça casse!
Code:

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!
13/03/2018, 08h21
NEC14

Bonjour et merci dysorthographie, mais où dois-je mettre ce code ?
13/03/2018, 08h29
Invité
Code:

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!
13/03/2018, 08h48
NEC14

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

1 pièce(s) jointe(s)

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

Code:

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:

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

13/03/2018, 09h17
NEC14

Avec ton exemple je comprends mieux. Je vais modifier mon projet et je te tiens au courant. Merci beaucoup
13/03/2018, 09h59
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)
13/03/2018, 10h12
Invité

1 pièce(s) jointe(s)
ça marchait mai comme je modifiais le mot de passe!
Code:

1 2 3 Sub test() Debug.Print PassWord(ThisWorkbook.Sheets(1), True) End Sub
13/03/2018, 10h42
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 :)

1 pièce(s) jointe(s)

Version Sauvegarde Passe Word!

Code:

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:

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

Voir 40 message(s) de cette discussion en une page