Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

P

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
P
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...
Trier par date Trier par votes

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+
 
Vote positif 0 Vote négatif
P

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
 
Vote positif 0 Vote négatif

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
 
Vote positif 0 Vote négatif
P

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
    15.7 KB · Affichages: 17
Vote positif 0 Vote négatif
P

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
 
Vote positif 0 Vote négatif
P

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:
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

N
  • Question
Microsoft 365 Recherche dans un tableau structuré à partir d'une TextBox
Réponses
11
Affichages
300
NONO14
N
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
528
AtTheOne
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
594
laurent950
R
  • Question
XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur
Réponses
1
Affichages
439
Aya_flo
A
C
  • Résolu(e)
XL 2021 Alimenter Listbox si colonne 3 contient un mot précis
Réponses
5
Affichages
518
Claudinedu13
C
S
  • Résolu(e)
Microsoft 365 Envoi de la signature de l'utilisateur macro envoi de mail
Réponses
3
Affichages
205
spike29
S
M
  • Question
XL 2010 Demande de quantité d'un produit dans un magasin spécifique selon la date la plus ancienne
2
Réponses
21
Affichages
1 K
Mody200
M
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
  • Résolu(e)
XL 2010 Mauvaise utilisation de la fonction InStr
Réponses
11
Affichages
617
jurassic pork
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
557
M@xu3L
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…