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

[pat66]

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

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 :

Sub protection()
With ThisWorkbook
 .Saved = -1: .ChangeFileAccess 3
Kill .FullName: .Close 0
End With
End Sub

 

[job75]

Bonjour pat66,

A priori il faut qu'il y ait une feuille portant le UserName donc utilisez :

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]

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]

Avec la macro que j'ai donnée une seule condition suffit : l'existence de la feuille portant le UserName.

 

[pat66]

oui j'ai bien compris pour ce qui est de vérifier les username, c'est super

mais pour la deuxième condition, comment lui demander d'afficher la ou les feuilles selon l'username voir #1

merci

 

[job75]

Bon d'accord alors utilisez :

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]

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

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

 

[pat66]

re,

je teste #6

 

[pat66]

Job75,

désolé j'ai testé #6, le classeur disparait à l'ouverture

 

[job75]

Chez moi sur Excel 2019 la macro du post #6 fonctionne bien.

Vérifiez qu'il y a bien une feuille portant votre UserName.

 

[pat66]

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)

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]

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

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