acualyisdolan Flotte mais jamais ne sombre | Attention, code pourri.
L'idée est d'utiliser la propriété xlSheetVisible pour afficher/masquer les onglets.
Pour ça j'ai une fonction ou je demande un mot de passe, que je compare à une table pour déterminer l'utilisateur correspondant, et je récupère le nom d'utilisateur pour vérifier ses accès aux différents onglets via une autre table. Si j'ai un truc dans la case à l'intersection entre le nom d'onglet et la ligne du pseudo, j'affiche l'onglet. Le truc à prendre en compte est de bien masquer à nouveau chaque onglet et à sauvegarder automatiquement à chaque fermeture du fichier. Enfin pour que le système soit robuste j'ai des fonctions pour créer de nouveaux onglets ou utilisateurs et compléter de manière adéquate les tables.
Tout ça est plus que perfectible. J'aurais pu faire de jolis userform, tout ça...
Mais ça avait été fait en speed pour des collègues trop cons qui n'ont pas été capable de témoigner un semblant de reconnaissance, alors bon j'ai pas creusé plus. 
Contenu de ThisWorkbook (trucs qui s'exécutent à chaque démarrage du fichier) :
Code :
- Public Droit_Admin As Boolean
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
-
- ' Lors de la fermeture du fichier, passage des feuilles en statut caché
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.Name <> "Menu" Then
- ws.Visible = xlVeryHidden
- End If
- Next ws
-
- ' Mise en lecture seule par l'appel de la fonction ToggleSheetProtection
- Call ToggleSheetProtection
-
- ' Sauvegarde la feuille
- For Each wb In Application.Workbooks:
- wb.Save
- Next wb
-
- End Sub
- Private Sub Workbook_NewSheet(ByVal Sh As Object)
- ' Empêche l'utilisateur de créer un onglet si la variable Admin est sur False
- If Droit_Admin = False Then
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Sh.Delete
- MsgBox ("Interdiction de créer une nouvelle feuille de calcul." & vbCr & _
- "Demander à l'administrateur de la feuille de calcul de rajouter une feuille." )
-
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
-
- Else
- ' Mise à jour de la table des droits d'accès
- Call Maj_Liste_Acces_Ajout
-
- ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
- Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
- Set StartCell_access = Range("A1" )
-
- LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
- StartCell_access.Column).End(xlUp).Row
-
- LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
- liste_access.Columns.Count).End(xlToLeft).Column
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Ajout des droits au compte admin
- row_val = 0
- col_val = 0
-
- For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
-
- If CStr(cell.Value) = CStr(Sh.Name) Then
- col_val = cell.Column
- End If
-
- Next cell
-
- For Each cell In Range(liste_access.Cells(2, 1), liste_access.Cells(LastRow_Access, 1)):
-
- If CStr(cell.Value) = "Admin" Then
- row_val = cell.Row
- End If
-
- Next cell
- If row_val <> 0 And col_val <> 0 Then
- liste_access.Cells(row_val, col_val).Value = "X"
- End If
- End If
-
- End Sub
|
Code dans la feuille "menu" (seule feuille visible pour tout le monde ; la ou les utilisateurs rentrent le mot de passe après avoir cliqué sur un bouton)
Code :
- Public Sub Worksheet_Activate()
- ' Quand l'onglet menu s'affiche on met à jour la liste des accès
- ' En appelant la fonction pour cela
- ' (Mesure de précaution)
- Call Maj_Liste_Acces_Ajout
- Call Maj_Liste_Access_Supr
- ThisWorkbook.Droit_Admin = False
- End Sub
|
Module 1:
Code :
- Public Sub Mdp_Verif()
- ' Déclaration des 2 variables booléennes
- ' Une pour vérifier si le mdp existe
- ' L'autre pour terminer une boucle while
-
- Dim mdp_exist As Boolean
- Dim loop_state As Boolean
-
- ' Détermination des dimensions de la feuille de calcul des mdp
- Set ws_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = ws_pass.Cells(ws_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = ws_pass.Cells(StartCell_Pass.Column, _
- ws_pass.Columns.Count).End(xlToLeft).Column
-
- ' On définit le nombre d'essai a 3 et la variable booléene sur True
- ' Si loop_state passe sur false on stoppe la boucle while
-
- loop_state = True
- nb_essai = 3
-
- ' boucle while d'entrée du mot de passe par inputbox
- ' Doit tourner 3 foix max, après loop_state passe a false
-
- While loop_state = True
-
- ' Demande du mot de passe
- input_mdp = InputBoxDK("Entrez votre mot de passe : " )
-
- ' Si l'utilisateur click sur cancel, on stop la fonction
- If input_mdp = vbNullString Then
- Exit Sub
-
- ' Sinon on continue
- Else
- ' On définit initialement la variable a False
- mdp_exist = False
-
- ' Boucle pour balayer la colonne mot de passe
- For j = 2 To LastRow_pass:
-
- ' Si le mot de passe est présent dans la colonne
- ' On met mdp_exist sur True et on termine la boucle for
- If ws_pass.Cells(j, 2).Value = input_mdp Then
- mdp_exist = True
- Exit For
-
- ' Sinon on continue à définir mdp_exist comme False
- Else
- mdp_exist = False
- End If
-
- Next j
-
- ' Si mdp_exist est sur True alors on va vérifier les droits d'accès
- ' Avec la fonction Verif_Droits(on passe le mdp en argument
- ' Et on termine la boucle while en mettant loop_state a False
- If mdp_exist = True Then
- Call Verif_Droits(CStr(input_mdp))
- loop_state = False
-
- ' Sinon on cache tout (au cas ou, en principe déjà caché)
- ' Et on décrémente notre compteur nb_essai de 1
- ' Si il tombe a 0 on passe loop_state à False pour terminer la boucle
-
- ElseIf mdp_exist = False Then
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.Name <> "Menu" Then
- ws.Visible = xlVeryHidden
- End If
- Next ws
-
- nb_essai = nb_essai - 1
-
- If nb_essai = 0 Then
- loop_state = False
-
- ' Si mdp_exist est False en plus de décrémenter
- ' On met un message d'erreur affichant le nombre d'essai restant
-
- Else
- MsgBox ("Mot de passe incorrect, veuillez essayer à nouveau" _
- & vbCr & "[" & nb_essai & "] essais restant." )
- End If
-
- End If
-
- End If
-
- Wend
-
- End Sub
- Public Sub Verif_Droits(mdp As String)
- ' Vérifier les pages que la personne associée au mot de passe a
- ' Et afficher les pages en correspondance
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Compare le mdp a la colonne mdp de la feuille de calcul
- ' Retourne le nom de la personne
- Count = 0
- last_i = 2
- For i = 2 To LastRow_pass:
- If CStr(mdp) = CStr(Liste_pass.Cells(i, 2).Value) Then
- nom_pers = CStr(Liste_pass.Cells(i, 1).Value)
- Count = Count + 1
- last_i = i
- Exit For
- End If
- Next i
-
- ' Boucle For pour compter si il y a des occurence après la dernière trouvée
- ' Permet de vérifier si plusieurs utilisateurs ont le même pass, cf. plus bas)
- For l = last_i + 1 To LastRow_pass:
- If CStr(mdp) = CStr(Liste_pass.Cells(l, 2).Value) Then
- Count = Count + 1
- End If
- Next l
-
- ' Prévention d'un PEBCAK : on signale via le counter (>1)
- ' Si plusieurs utilisateurs ont le même mdp
- ' Le Exit For précédent permet de stopper la boucle après la première occurrence
- ' Et le second If compte les occurrences suivantes s'il y a
-
- If Count > 1 Then
- MsgBox ("Attention ! Plusieurs personnes ont le même mot de passe." & vbCr & _
- "Sélection de la première dans la liste" )
- End If
-
- ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
- Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
- Set StartCell_access = Range("A1" )
-
- LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
- StartCell_access.Column).End(xlUp).Row
-
- LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
- liste_access.Columns.Count).End(xlToLeft).Column
-
- ' Affichage des feuilles de calcul en fonction des droits
- ' Pour l'utilisateur on balaie la ligne, si une case est non nulle
- ' On récupère le nom de la première ligne de cette colonne (nom de la feuille a afficher)
- ' Et on affiche la feuille correspondante
- ' On stocke dans une chaine "liste_acces" les noms des feuilles accessibles à la personne
- ' Pour ensuite enregistrer cette information dans l'audit trail
- liste_acces = ""
- For j = 2 To LastRow_Access:
- If nom_pers = liste_access.Cells(j, 1) Then
- For k = 2 To LastColumn_Access:
- If liste_access.Cells(j, k).Value <> vbblank Then
-
- ' On rend la feuille visible
- Sheets(liste_access.Cells(1, k).Value).Visible = True
- liste_acces = liste_acces & " " & liste_access.Cells(1, k).Value
- End If
-
- Next k
-
- Exit For
-
- End If
-
- Next j
-
- ' Si droits admin, on passe la variable globale à True
- If Sheets("Admin" ).Visible = xlSheetVisible Then
- ThisWorkbook.Droit_Admin = True
- Else
- ThisWorkbook.Droit_Admin = False
- End If
-
- ' Appel de la fonction Audit Trail
- ' En argument, l'utilisateur qui se login et sa liste d'accès
- Call Aj_Audit_Trail(CStr(nom_pers), CStr(liste_acces))
-
- End Sub
- Public Sub Ajout_Feuille_Calcul_Admin()
- ' Permet de rajouter une feuille de calcul au click
-
- ' Si droits admin, on passe la variable globale à True
- If Sheets("Admin" ).Visible = xlSheetVisible Then
- ThisWorkbook.Droit_Admin = True
- Else
- ThisWorkbook.Droit_Admin = False
- End If
-
- If ThisWorkbook.Droit_Admin = True Then
- ' Déclaration d'une table avec les nom des feuilles de calcul existante
- Dim tab_nom_feuille() As String
- ReDim tab_nom_feuille(0 To 1)
-
- i = 0
- ' On renseigne la table
- For Each ws In ActiveWorkbook.Worksheets:
- tab_nom_feuille(i) = ws.Name
- ReDim Preserve tab_nom_feuille(0 To i + 1)
- i = i + 1
- Next ws
-
- ' Demande du nom à donner à la feuille
- nom_feuille_a_ajouter = InputBox("Rentrer le nom de la table à ajouter :" )
-
- ' Si l'utilisateur click sur cancel, on stoppe la fonction
- If nom_feuille_a_ajouter = vbNullString Then
- Exit Sub
-
- ' Sinon on teste si ce nom existe déjà
- Else
- If IsInArray(CStr(nom_feuille_a_ajouter), tab_nom_feuille) = True Then
- MsgBox ("Une feuille portant ce nom existe déjà." )
- Exit Sub
- Else
- Sheets.Add(Before:=Worksheets("Table_Mot_De_Passe" )).Name = CStr(nom_feuille_a_ajouter)
- End If
-
- ' Mise à jour de la table des droits d'accès
- Call Maj_Liste_Acces_Ajout
-
- ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
- Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
- Set StartCell_access = Range("A1" )
-
- LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
- StartCell_access.Column).End(xlUp).Row
-
- LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
- liste_access.Columns.Count).End(xlToLeft).Column
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Ajout des droits au compte admin
- row_val = 0
- col_val = 0
-
- For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
-
- If CStr(cell.Value) = CStr(nom_feuille_a_ajouter) Then
- col_val = cell.Column
- End If
-
- Next cell
-
- For Each cell In Range(liste_access.Cells(2, 1), liste_access.Cells(LastRow_Access, 1)):
-
- If CStr(cell.Value) = "Admin" Then
- row_val = cell.Row
- End If
-
- Next cell
- If row_val <> 0 And col_val <> 0 Then
- liste_access.Cells(row_val, col_val).Value = "X"
- End If
- End If
-
- End If
- End Sub
|
Module 2
Code :
- ' Module contenant les diverse fonctions des boutons d'accès
- Public Sub Btn_Access_Tab()
- ' Précaution, on met les droits admin à False
- ThisWorkbook.Droit_Admin = False
-
- ' Au cas ou la feuille soit déjà ouverte avec un autre utilisateur
- ' Au click sur le bouton on "delog" ce dernier en cachant toutes les feuilles
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.Name <> "Menu" Then
- ws.Visible = xlVeryHidden
- End If
- Next ws
-
- ' Mise en lecture seule par l'appel de la fonction ToggleSheetProtection
- Call ToggleSheetProtection
-
- For Each wb In Application.Workbooks:
- wb.Save
- Next wb
-
- ' Appel de la fonction de vérification du mdp
- Call Mdp_Verif
-
- End Sub
- Public Sub Btn_Access_Mdp()
- ' Ouvre la feuille "Table_Mot_De_Passe" (bouton admin uniquement)
- ActiveWorkbook.Worksheets("Table_Mot_De_Passe" ).Activate
- End Sub
- Public Sub Btn_Access_Droits()
- ' Ouvre la feuille "Table_Droits_Lecture_Feuilles" (bouton admin uniquement)
- ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" ).Activate
- End Sub
- Public Sub Btn_Access_Admin()
- ' Ouvre la feuille "Admin" (bouton admin uniquement)
- ActiveWorkbook.Worksheets("Admin" ).Activate
- End Sub
- Public Sub Btn_Access_Menu()
- ' Ouvre la feuille "Menu"
- ActiveWorkbook.Worksheets("Menu" ).Activate
- End Sub
- Public Sub Btn_ToggleSheetProtection()
- Call ToggleSheetProtection
- End Sub
- Public Sub Btn_Ajout_Feuille()
- Call Ajout_Feuille_Calcul_Admin
- End Sub
- Public Sub Btn_Rm_Protec()
- Call RemoveSheetProtection
- End Sub
|
Module 3 :
Code :
- ' Fonction pour mettre à jour, à chaque sélection de l'onglet "menu", la liste des accès
- Public Sub Maj_Liste_Acces_Ajout()
- ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
- Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
- Set StartCell_access = Range("A1" )
-
- LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
- StartCell_access.Column).End(xlUp).Row
-
- LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
- liste_access.Columns.Count).End(xlToLeft).Column
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Définition tableau liste de personnes dans table d'accès existante
- Dim tab_pers() As String
- ReDim tab_pers(0 To 1)
-
- ' Définition tableau liste de feuilles dans table d'accès existante
- Dim tab_feuilles() As String
- ReDim tab_feuilles(0 To 1)
-
- ' Récupération de la liste des personnes (colonne 1 feuille mdp)
- val_tab = 0
- For Each cell In Range(Liste_pass.Cells(2, 1), Liste_pass.Cells(LastRow_pass, 1)):
- tab_pers(val_tab) = cell.Value
- ReDim Preserve tab_pers(0 To val_tab + 1)
- val_tab = val_tab + 1
- Next cell
-
- ' Récupération de la liste des onglets
- val_tab = 0
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.Name <> "Menu" Then
- tab_feuilles(val_tab) = ws.Name
- ReDim Preserve tab_feuilles(0 To val_tab + 1)
- val_tab = val_tab + 1
- End If
- Next ws
-
-
- ' Chaine qui concatène les noms de la ligne
- pers_presentes_dans_feuille_droits = ""
-
- For i = 2 To LastRow_Access:
- If liste_access.Cells(i, 1).Value <> vbblank Then
- pers_presentes_dans_feuille_droits = pers_presentes_dans_feuille_droits & liste_access.Cells(i, 1).Value
- End If
- Next i
-
- ' Chaine qui concatène les noms des feuilles présente dans la feuille de calcul droit
- feuilles_presentes_dans_feuille_droits = ""
-
- For j = 2 To LastColumn_Access:
- If liste_access.Cells(1, j).Value <> vbblank Then
- feuilles_presentes_dans_feuille_droits = feuilles_presentes_dans_feuille_droits & liste_access.Cells(1, j).Value
- End If
- Next j
-
- ' Fonction InStr pour comparer les chaines générées au contenu du tableau personne
- For i = 0 To UBound(tab_pers) - 1:
- ' Cas ou la colonne est vide
- If pers_presentes_dans_feuille_droits = "" Then
- liste_access.Cells(LastRow_Access + 1, 1).Value = tab_pers(i)
- LastRow_Access = LastRow_Access + 1
-
- ' Autre cas : si on a une occurence qui sort avec Instr, on teste chaque valeur
- ' La boucle For, si tombe sur une égalité de valeur entre l'entrée du tableau et la colonne
- ' Termine la boucle et incrémente val_pres
- ' Une entrée est rajoutée uniquement si val_pres est nulle (autrement l'entrée est déjà presente)
-
- ElseIf InStr(1, pers_presentes_dans_feuille_droits, tab_pers(i), vbTextCompare) <= 1 Then
-
- val_pres = 0
- For k = 2 To LastRow_Access:
- If liste_access.Cells(k, 1).Value = tab_pers(i) Then
- k = LastRow_Access
- val_pres = val_pres + 1
- End If
- Next k
-
- If val_pres = 0 Then
- liste_access.Cells(LastRow_Access + 1, 1).Value = tab_pers(i)
- LastRow_Access = LastRow_Access + 1
- End If
-
- End If
- Next i
-
- ' Fonction InStr pour comparer les chaines générées au contenu du tableau feuilles
- For j = 0 To UBound(tab_feuilles) - 1:
- If feuilles_presentes_dans_feuille_droits = "" Then
- liste_access.Cells(1, LastColumn_Access + 1).Value = tab_feuilles(j)
- LastColumn_Access = LastColumn_Access + 1
-
- ElseIf InStr(1, feuilles_presentes_dans_feuille_droits, tab_feuilles(j), vbTextCompare) = 0 Then
- liste_access.Cells(1, LastColumn_Access + 1).Value = tab_feuilles(j)
- LastColumn_Access = LastColumn_Access + 1
- End If
- Next j
-
- End Sub
- Public Sub Maj_Liste_Access_Supr()
- ' Supprime de la feuille de calcul "Table_Droits_Lecture_Feuilles"
- ' Les entrées qui ne sont pas dans la liste des mots de passe/les feuilles de calcul
-
- ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
- Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
- Set StartCell_access = Range("A1" )
-
- LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
- StartCell_access.Column).End(xlUp).Row
-
- LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
- liste_access.Columns.Count).End(xlToLeft).Column
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Définition tableau liste de personnes dans table d'accès existante
- Dim tab_pers() As String
- ReDim tab_pers(0 To 1)
-
- ' Définition tableau liste de feuilles dans table d'accès existante
- Dim tab_feuilles() As String
- ReDim tab_feuilles(0 To 1)
-
- ' Récupération de la liste des personnes (colonne 1 feuille mdp)
- val_tab = 0
- For Each cell In Range(Liste_pass.Cells(2, 1), Liste_pass.Cells(LastRow_pass, 1)):
- tab_pers(val_tab) = cell.Value
- ReDim Preserve tab_pers(0 To val_tab + 1)
- val_tab = val_tab + 1
- Next cell
-
- ' Récupération de la liste des onglets
- val_tab = 0
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.Name <> "Menu" Then
- tab_feuilles(val_tab) = ws.Name
- ReDim Preserve tab_feuilles(0 To val_tab + 1)
- val_tab = val_tab + 1
- End If
- Next ws
-
- ' Boucle sur la première colonne de la feuille "Table_Droits_Lecture_Feuilles"
- ' On regarde si la valeur est dans le tableau tab_pers
- ' Si l'entrée n'y est pas, on la supprime
- For i = 2 To LastRow_Access:
- If IsInArray(CStr(Cells(i, 1).Value), tab_pers) = False Then
- liste_access.Rows(i).EntireRow.Delete
- i = i - 1
- End If
- Next i
-
- ' Boucle sur la première ligne de la feuille "Table_Droits_Lecture_Feuilles"
- ' On regarde si la valeur est dans le tableau tab_feuille
- ' Si l'entrée n'y est pas, on la supprime
- For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
- If IsInArray(CStr(cell.Value), tab_feuilles) = False Then
- liste_access.Columns(cell.Column).EntireColumn.Delete
- End If
- Next cell
-
- End Sub
|
Module 4
Code :
- Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
- ' Pris sur https://stackoverflow.com/questions/38267950/check-if-a-value-is-in-an-array-or-not-with-excel-vba
- Dim i
- For i = 0 To UBound(arr)
- If arr(i) = stringToBeFound Then
- IsInArray = True
- Exit Function
- End If
- Next i
- IsInArray = False
-
- End Function
- Public Sub ToggleSheetProtection()
- ' Idée prise sur https://superuser.com/questions/914 [...] a-password
-
- ' Définition d'un tableau avec le nom des feuilles à exclure
- Dim tab_nom_exc() As String
- ReDim tab_nom_exc(0 To 4)
- tab_nom_exc(0) = "Admin"
- tab_nom_exc(1) = "Table_Mot_De_Passe"
- tab_nom_exc(2) = "Table_Droits_Lecture_Feuilles"
- tab_nom_exc(3) = "Menu"
- tab_nom_exc(4) = "Audit_Trail"
-
- ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
- Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
- Set StartCell_Pass = Range("A1" )
-
- LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
- StartCell_Pass.Column).End(xlUp).Row
-
- LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
- Liste_pass.Columns.Count).End(xlToLeft).Column
-
- ' Compare le login Admin a la colonne mdp de la feuille de calcul
- ' Retourne le mdp
- Count = 0
- For i = 1 To LastRow_pass:
- If CStr("Admin" ) = CStr(Liste_pass.Cells(i, 1).Value) Then
- mdp_admin = CStr(Liste_pass.Cells(i, 2).Value)
- Exit For
- End If
- Next i
-
-
- ' Met ou enlève la protection sur les feuilles de calcul
- ' Qui sont dans le tableau défini juste avant
- ' Le mot de passe est celui de l'admin trouvé par la boucle précédente
- For Each ws In ActiveWorkbook.Worksheets:
- If IsInArray(CStr(ws.Name), tab_nom_exc) = False Then
- ws.Protect mdp_admin, True, True, True, True
- End If
- Next ws
-
- End Sub
- Public Sub RemoveSheetProtection()
- For Each ws In ActiveWorkbook.Worksheets:
- If ws.ProtectContents Then
- ws.Unprotect
- End If
- Next ws
- End Sub
|
Module 5
Code :
- Option Explicit
- ' InputBox spéciale mot de passe
- ' Pris sur http://www.office-loesung.de/ftopic74191_0_0_asc.php
- 'Code geschrieben von Daniel Klann
- Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
- ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
- Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
- Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
- (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
- ByVal dwThreadId As Long) As Long
- Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
- Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
- (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
- ByVal wParam As Long, ByVal lParam As Long) As Long
- Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
- ByVal lpClassName As String, _
- ByVal nMaxCount As Long) As Long
- Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
- Private Const EM_SETPASSWORDCHAR = &HCC
- Private Const WH_CBT = 5
- Private Const HCBT_ACTIVATE = 5
- Private Const HC_ACTION = 0
- Private hHook As Long
- Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Dim RetVal
- Dim strClassName As String, lngBuffer As Long
- If lngCode < HC_ACTION Then
- NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
- Exit Function
- End If
- strClassName = String$(256, " " )
- lngBuffer = 255
- If lngCode = HCBT_ACTIVATE Then
- RetVal = GetClassName(wParam, strClassName, lngBuffer)
- If Left$(strClassName, RetVal) = "#32770" Then
- SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*" ), &H0
- End If
- End If
- CallNextHookEx hHook, lngCode, wParam, lParam
- End Function
- Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
- Optional YPos, Optional HelpFile, Optional Context) As String
- Dim lngModHwnd As Long, lngThreadID As Long
- lngThreadID = GetCurrentThreadId
- lngModHwnd = GetModuleHandle(vbNullString)
- hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
- InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
- UnhookWindowsHookEx hHook
- End Function
|
Module 6 (lui je sais plus ce qu'il est sensé faire, je crois que j'avais essayé de jouer avec les CappsEvents mais au final laissé tomber, ça doit être un reliquat)
Code :
- Private Sub Worksheet_SelectionChange(ByVal Target As Range)
- Dim CommBarTmp, Commbar As CommandBar
- For Each Commbar In Application.CommandBars
- Set CommBarTmp = Commbar.FindControl(ID:=847, recursive:=True)
- If Not CommBarTmp Is Nothing Then CommBarTmp.Enabled = False
- Next
- End Sub
|
Message édité par acualyisdolan le 09-03-2019 à 11:01:21
---------------
Sondage pharmacien@HFR ici : https://goo.gl/forms/7cIJiIFNm0lKGOfm1
|
FORUM HardWare.fr
![[:acualyisdolan]](https://forum-images.hardware.fr/images/perso/acualyisdolan.gif "[:acualyisdolan]")
