XL 2019 Macro protection s'active si username absent de la liste

pat66

XLDnaute Impliqué
Bonjour le forum,

Pourriez vous m'aider à compléter cette macro avec le module ci après,
je souhaiterai que si l'username ne fait pas parti de la liste, la macro protection s'active

merci beaucoup

VB:
Private Sub Workbook_Open()
  On Error Resume Next
  Sheets(Environ("username")).Visible = True
  For i = 1 To Range("User").Count
    If UCase(Environ("username")) = UCase(Range("User")(i)) Then
       x = Range("feuille")(i)
       Sheets(x).Visible = True
    End If
   Next i
  end sub

dans un module :

Code:
Sub protection()
With ThisWorkbook
 .Saved = -1: .ChangeFileAccess 3
Kill .FullName: .Close 0
End With
End Sub
 
Solution
Job75, le forum

voici la solution qui résout mon problème grâce à votre aide, une mélange des 2 macros qui à l'air de fonctionner parfaitement
1 , à l'ouverture, elle vérifie si utilisateur est dans la liste, sinon autodestruction
2 , si ok, elle affiche les feuilles autorisées selon L'Username (voir #7)

merci à Job75 et à Boisgontier pour leur aide si précieuse
car il faut rendre à César ce qui est à César

cdt


VB:
Private Sub Workbook_Open()
    nom = Environ("username")
    Set temp = [User].Find(what:=nom)
    If temp Is Nothing Then
    Me.ChangeFileAccess xlReadOnly
    Me.Saved = True
    Kill Me.FullName
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
Else
    For i = 1 To Range("User").Count
        If...

job75

XLDnaute Barbatruc
Bonjour pat66,

A priori il faut qu'il y ait une feuille portant le UserName donc utilisez :
VB:
Private Sub Workbook_Open()
On Error Resume Next
Sheets(Environ("UserName")).Visible = xlSheetVisible
If Err = 0 Then Exit Sub
Me.ChangeFileAccess xlReadOnly
Me.Saved = True
Kill Me.FullName 'détruit le fichier
If Workbooks.Count = 1 Then Application.Quit Else Me.Close
End Sub
A+
 

pat66

XLDnaute Impliqué
bonjour Job75,
ravi de vous lire

oui, en fait, les username sont sur une feuille masquée où j'ai nommée deux plages : "User" et "Feuille"
"User" : plage qui contient la liste de tous les username autorisés,
condition 1 : si l'utilisateur n'est pas dans cette liste, = autodestruction du classeur

"Feuille" : plage qui contient la ou les feuilles à afficher selon l'username de l'utilisateur
condition 2 : vérifie dans la plage "Feuille" les onglets à afficher selon l'username de l'utilisateur

Hors dans ce que vous me proposez, la condition "Feuille", n'est plus
Si besoin je peux vous joindre un exemple sous excel
cdt
 

job75

XLDnaute Barbatruc
Bon d'accord alors utilisez :
VB:
Private Sub Workbook_Open()
Dim nom$, i&, x$
nom = Environ("UserName")
On Error Resume Next
Sheets(nom).Visible = xlSheetVisible
If Err Then
    Me.ChangeFileAccess xlReadOnly
    Me.Saved = True
    Kill Me.FullName
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
Else
    For i = 1 To Range("User").Count
        If UCase(nom) = UCase(Range("User")(i)) Then
            x = CStr(Range("feuille")(i))
            Sheets(x).Visible = xlSheetVisible
        End If
   Next i
End If
End Sub
 

pat66

XLDnaute Impliqué
La macro du # 1 fonctionne très bien, elle vient de boisgontier
pour aider à comprendre, voici les 2 plages nommées dans l'image ci jointe
je souhaite conserver cette macro et simplement faire en sorte que l'utilisateur n'est pas dans la liste, le classeur s'autodétruise

j'ai testé , mais sans succès
VB:
Private Sub Workbook_Open()
On Error Resume Next
Sheets(Environ("UserName")).Visible = xlSheetVisible
If Err Then
    Me.ChangeFileAccess xlReadOnly
    Me.Saved = True
    Kill Me.FullName
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
Else
 On Error Resume Next
  Sheets(Environ("username")).Visible = True
  For i = 1 To Range("User").Count
    If UCase(Environ("username")) = UCase(Range("User")(i)) Then
       x = Range("feuille")(i)
       Sheets(x).Visible = True
    End If
   Next i
End If
End Sub
 

Pièces jointes

  • essai.jpg
    essai.jpg
    15.7 KB · Affichages: 16

pat66

XLDnaute Impliqué
oui j'ai bien vérifié, le classeur disparait !!

Celle ci fonctionne bien, mais j'aurai aimé n'en faire qu'une avec votre façon de supprimer le classeur au lieu d'appeler la macro protection (Suicid)

VB:
Private Sub Workbook_Open()

        nom = Environ("username")
    Set temp = [User].Find(what:=nom)
    If temp Is Nothing Then
        Call suicid
    End If

  On Error Resume Next
  Sheets(Environ("username")).Visible = True
  For i = 1 To Range("User").Count
    If UCase(Environ("username")) = UCase(Range("User")(i)) Then
       x = Range("feuille")(i)
       Sheets(x).Visible = True
    End If
  Next i
end sub
 

pat66

XLDnaute Impliqué
Job75, le forum

voici la solution qui résout mon problème grâce à votre aide, une mélange des 2 macros qui à l'air de fonctionner parfaitement
1 , à l'ouverture, elle vérifie si utilisateur est dans la liste, sinon autodestruction
2 , si ok, elle affiche les feuilles autorisées selon L'Username (voir #7)

merci à Job75 et à Boisgontier pour leur aide si précieuse
car il faut rendre à César ce qui est à César

cdt


VB:
Private Sub Workbook_Open()
    nom = Environ("username")
    Set temp = [User].Find(what:=nom)
    If temp Is Nothing Then
    Me.ChangeFileAccess xlReadOnly
    Me.Saved = True
    Kill Me.FullName
    If Workbooks.Count = 1 Then Application.Quit Else Me.Close
Else
    For i = 1 To Range("User").Count
        If UCase(nom) = UCase(Range("User")(i)) Then
            x = CStr(Range("feuille")(i))
            Sheets(x).Visible = xlSheetVisible
        End If
   Next i
End If
end sub
 
Dernière édition:

Discussions similaires