Autorisation à partir de l'identifiant de connexion

Le
Sunburn
Bonjour,
j'ai ma macro tel que suivant :
-
Sub PROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title:="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Worksheets("G").Range("J5").Value = ("Vérouillé")
Worksheets("G").Range("K5").Value = Environ("username") & " " & Format(Date,
"DD/MM/YY")
Dim f As Worksheet
For Each f In Sheets
ProtegeFeuille f.Name, mdp
Next f
End Sub
Sub DEPROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title:="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Dim f As Worksheet
For Each f In Sheets
DeprotegeFeuille f.Name, mdp
Next f
Worksheets("G").Range("J5").Value = ("Non Vérouillé")
Worksheets("G").Range("K5").ClearContents
End Sub
Function DeprotegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnOs
DeprotegeFeuille = Worksheets(nomf).Unprotect(mdp)
Exit Function
YaUnOs:
msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
Function ProtegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnBinz
ProtegeFeuille = Worksheets(nomf).Protect(mdp)
Exit Function
YaUnBinz:
msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
-

elle me permet d'avoir un mot de passe afin d'accéder au blocage du classeur.
Je voudrais, à la place d'un mot de passe, autoriser l'accès à ce menu,
seulement à 5 initiales de connexion (username = TUL ; HYU; UYA; YJU; et
FJI). Pour les autres, message "Désolé, vous n'avez pas le droit !".
Comment puis-je faire?
Je vous remercie.

Yann
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Sunburn
Le #5015331
un petit complément :
je voudrais, qu'une fois verouillé par l'une de ces personnes, seule la
personne qui a vérouillé ce fichier puisse y avoir accès.
Si besoin, on peut stocker des données dans ma page principale, "G", après
la ligne 100.
Merci.
Yann
lSteph
Le #5015141
Bonjour
(pour le complément je ne saisis pas bien ...)

pour ta demande initiale je verrais plutôt ce qui suit
à mettre dans thisworkbook



Option Explicit

Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet
For Each sh In Me.Sheets
sh.Protect "toto"
Next
End Sub

Private Sub Workbook_Open()
Dim sh As Worksheet
Select Case UCase(Environ("UserName"))

Case "TUL", "HYU", "UYA", "YJU", "FJI"

For Each sh In Me.Sheets
sh.Unprotect "toto"
Next
case else
msgbox "les feuilles sont protégées"
End Select
End Sub

'lSteph

On 29 oct, 11:56, Sunburn
Bonjour,
j'ai ma macro tel que suivant :
-------
Sub PROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title: ="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Worksheets("G").Range("J5").Value = ("Vérouillé")
Worksheets("G").Range("K5").Value = Environ("username") & " " & Format( Date,
"DD/MM/YY")
Dim f As Worksheet
For Each f In Sheets
ProtegeFeuille f.Name, mdp
Next f
End Sub
Sub DEPROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title: ="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Dim f As Worksheet
For Each f In Sheets
DeprotegeFeuille f.Name, mdp
Next f
Worksheets("G").Range("J5").Value = ("Non Vérouillé")
Worksheets("G").Range("K5").ClearContents
End Sub
Function DeprotegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnOs
DeprotegeFeuille = Worksheets(nomf).Unprotect(mdp)
Exit Function
YaUnOs:
msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
Function ProtegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnBinz
ProtegeFeuille = Worksheets(nomf).Protect(mdp)
Exit Function
YaUnBinz:
(msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
-------

elle me permet d'avoir un mot de passe afin d'accéder au blocage du cla sseur.
Je voudrais, à la place d'un mot de passe, autoriser l'accès à ce m enu,
seulement à 5 initiales de connexion (username = TUL ; HYU; UYA; YJU; et
FJI). Pour les autres, message "Désolé, vous n'avez pas le droit !".
Comment puis-je faire?
Je vous remercie.

Yann


Sunburn
Le #5014941
Bonjour steph,
Option Explicit
Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet
For Each sh In Me.Sheets
sh.Protect "toto"
Next
End Sub


je ne pense pas que celà fonctionne pour moi, car je ne veux pas que ça se
passe systématiquement à la fermeture du fichier, mais seulement à un moment
donné, lorsque je veux "vérouiller le dossier". C'est pourquoi il faudrait un
code qui s'exécute lorque j'éxécute ma macro, pas à chaque fermeture.

merci.

lSteph
Le #5014891
Bonjour,

Tu as regardé un peu vite!
Qui parle de fermeture du fichier?
la partie de code que tu as repris correspond à l'enregistrement du
fichier.
Elle n'est pas dissociable , dans l'objectif voulu de celle qui agit à
l'ouverture et que tu as zappé selon ce retour,

Tes utilisateurs s'ils ont ouvert vont probablement enregistrer à la
fermeture, il faut bien que cela reste protègé, surtout s'ils
s'avisent de ne pas activer les macros.

A l'ouverture cela déprotège uniquement si on a activé les macros et
que le username correspond.

Cordialement.

'lSteph

On 29 oct, 16:30, Sunburn
Bonjour steph,

Option Explicit
Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet
For Each sh In Me.Sheets
sh.Protect "toto"
Next
End Sub


je ne pense pas que celà fonctionne pour moi, car je ne veux pas que ça se
passe systématiquement à la fermeture du fichier, mais seulement à un moment
donné, lorsque je veux "vérouiller le dossier". C'est pourquoi il fau drait un
code qui s'exécute lorque j'éxécute ma macro, pas à chaque fermet ure.

merci.



lSteph
Le #5014871
Re,

On ne le rappellera jamais assez.

A préciser toutefois que cette solution est donnée uniquement,
histoire de savoir comment on peut faire cela avec vba.
Dans la réalité, il conviendra plutôt de baser toute autre méthode sur
un peu plus de confiance (éclairée) et un peu moins de pseudos
barrières futiles.
Il ne faut jamais perdre de vue que toutes ces protections sont
contournables avec une facilité déconcertante,. Même pas besoin de
comprendre quelquechose aux macros, suffit de savoir ce qui existe sur
le net.

Cordialement.

--
lSteph





On 29 oct, 14:48, lSteph
Bonjour
(pour le complément je ne saisis pas bien ...)

pour ta demande initiale je verrais plutôt ce qui suit
à mettre dans thisworkbook

Option Explicit

Private Sub Workbook_BeforeSave(ByVal _
SaveAsUI As Boolean, Cancel As Boolean)
Dim sh As Worksheet
For Each sh In Me.Sheets
sh.Protect "toto"
Next
End Sub

Private Sub Workbook_Open()
Dim sh As Worksheet
Select Case UCase(Environ("UserName"))

Case "TUL", "HYU", "UYA", "YJU", "FJI"

For Each sh In Me.Sheets
sh.Unprotect "toto"
Next
case else
msgbox "les feuilles sont protégées"
End Select
End Sub

'lSteph

On 29 oct, 11:56, Sunburn
Bonjour,
j'ai ma macro tel que suivant :
-------
Sub PROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title: ="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Worksheets("G").Range("J5").Value = ("Vérouillé")
Worksheets("G").Range("K5").Value = Environ("username") & " " & Forma t(Date,
"DD/MM/YY")
Dim f As Worksheet
For Each f In Sheets
ProtegeFeuille f.Name, mdp
Next f
End Sub
Sub DEPROTEGER()
Dim mdp As String
mdp = Application.InputBox(prompt:="Saisir le Mot de passe", Title: ="Mot de
passe ?", Type:=2)
If mdp <> "h" Then _
MsgBox "Désolé mauvais mot de passe", vbCritical, _
"Erreur": Exit Sub
Dim f As Worksheet
For Each f In Sheets
DeprotegeFeuille f.Name, mdp
Next f
Worksheets("G").Range("J5").Value = ("Non Vérouillé")
Worksheets("G").Range("K5").ClearContents
End Sub
Function DeprotegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnOs
DeprotegeFeuille = Worksheets(nomf).Unprotect(mdp)
Exit Function
YaUnOs:
msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
Function ProtegeFeuille(nomf As String, mdp As String)
On Error GoTo YaUnBinz
ProtegeFeuille = Worksheets(nomf).Protect(mdp)
Exit Function
YaUnBinz:
(msg = "Problème rencontré dans l'exécution : "
msg = vbLf & vbLf & Err.Description
MsgBox msg
End Function
-------

elle me permet d'avoir un mot de passe afin d'accéder au blocage du c lasseur.
Je voudrais, à la place d'un mot de passe, autoriser l'accès à ce menu,
seulement à 5 initiales de connexion (username = TUL ; HYU; UYA; YJ U; et
FJI). Pour les autres, message "Désolé, vous n'avez pas le droit !".
Comment puis-je faire?
Je vous remercie.

Yann




Publicité
Poster une réponse
Anonyme