Forum |  HardWare.fr | News | Articles | PC | Prix | S'identifier | S'inscrire | Aide | Shop Recherche
455 connectés 

 



 Mot :   Pseudo :  
 
 Page :   1  2
Page Suivante
Auteur Sujet :

Macro Excel : Accès restreint par onglet suivant utilisateur

n°2315301
dje69r
Arme de distraction massive
Posté le 15-05-2018 à 09:31:56  profilanswer
 

Reprise du message précédent :
Et tu as quoi de surligné dans le code ?
Les deux lignes que tu as mises en rouge ?


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
mood
Publicité
Posté le 15-05-2018 à 09:31:56  profilanswer
 

n°2315305
liln
Posté le 15-05-2018 à 09:52:37  profilanswer
 

oui exact

n°2315306
liln
Posté le 15-05-2018 à 09:55:33  profilanswer
 

la syntaxe me parait correcte pourtant, j'ai essayé avec des espaces ou sans, sans les parenthèses ou avec, en remplaçant les guillemets par des apostrophes...

n°2315308
dje69r
Arme de distraction massive
Posté le 15-05-2018 à 10:49:55  profilanswer
 

Dans un module VBA, va dans "outils" "references" et regarde si tu n'en as pas un en "MANQUANT" ou si les ref à Excel sont bien présentes


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
n°2315309
liln
Posté le 15-05-2018 à 10:55:20  profilanswer
 

Dans les references disponibles je n'en ai que 4 de cochées et rien d'autre aprés concernant Excel:
Visual Basic For Applications
Microsoft Excel 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library

n°2315310
liln
Posté le 15-05-2018 à 10:58:57  profilanswer
 

aucun maquant signalé...pfff il y a de quoi devenir fou surtout que je sens  qu'il s'agit certainement de détails

n°2315312
dje69r
Arme de distraction massive
Posté le 15-05-2018 à 12:07:01  profilanswer
 

Bah là
Sur un inputbox en plus
Envoie le fichier ça ira surement plus vite :whistle:


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
n°2315325
liln
Posté le 15-05-2018 à 16:11:00  profilanswer
 

c'est bon j'ai fini par trouver une solution étonnante: j'ai retapé le code à l'identique à la main après divers tests et plus de message d'erreur. Par contre il ne lance pas ma macro à l'ouverture comme prévu; ci-après le code modifié:
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'on affiche la feuille Vierge
Sheets("Vierge" ).Visible = True
'on planque toutes les autres feuilles sauf Vierge
For x = 1 To ThisWorkbook.Sheets.Count
If Sheets(x).Name <> "Vierge" Then Sheets(x).Visible = xlSheetVeryHidden
Next
--------------------------------------------------------------------------------------------
End Sub
 
Private Sub Workbook_Open()
On Error Resume Next
 
Application.ScreenUpdating = False
'on defini un pointeur
Pointeur = 0
'on affiche la feuille Vierge
Sheets("Vierge" ).Visible = True
'on va dessus
Sheets("Vierge" ).Activate
'on planque toutes les autres
For x = 1 To ThisWorkbook.Sheets.Count
    If Sheets(x).Name <> "Vierge" Then Sheets(x).Visible = xlSheetVeryHidden
Next
'on saisit le user
User = InputBox("Veuillez saisir votre nom d'utilisateur: ", "Utilisateur" )
'on saisit le mot de passe
MDP = InputBox("Veuillez saisir votre mot de passe: ", "Mot de passe" )
 
'TestShu = InputBox ("Veuillez saisir votre mot de passe: ", "Mot de passe" )  
'Derniere ligne du tableau de la feuille DroitsUsers pour boucler dessus
DerLigne = Sheets("DroitsUsers" ).Range("A65536" ).End(xlUp).Row
 
'DerLigne = Sheets("DroitsUsers" ). Range("A65536" ). End(xlUp). Row    
'on boucle pour trouver les occurences, x=2 car je pars du principe que la premiere ligne _
contient les entetes de colonne
For x = 2 To DerLigne
    'si ce qu'il y a dans la colonne1 (Colonne A : user) = le user saisi _
    ET ce qu'il y a dans la colonne2 (Colonne B : mot de passe)
    If Worksheets("DroitsUsers" ).Cells(x, 1) = User And Worksheets("DroitsUsers" ).Cells(x, 2) = MDP Then
        'on affiche la feuille définie en colonne3 (Colonne C : Feuille autorisée)
        'on affiche la feuille correspondante
        FeuilleVisible = Worksheets("DroitsUsers" ).Cells(x, 3)
        Sheets(FeuilleVisible).Visible = True
        '   on va dessus
        Sheets(FeuilleVisible).Activate
        'on se met un pointeur pour voir si on trouve quelque chose, si on ne trouve rien on quitte
        Pointeur = Pointeur + 1
    ElseIf Worksheets("DroitsUsers" ).Cells(x, 1) = "Admin" And Worksheets("DroitsUsers" ).Cells(x, 2) = "LeMDP" Then
        For i = 1 To ThisWorkbook.Sheets.Count
            If Sheets(i).Name <> "Vierge" Then Sheets(i).Visible = True
        Next
    Application.ScreenUpdating = True
    End If
Next
End Sub

n°2315326
liln
Posté le 15-05-2018 à 16:20:51  profilanswer
 

code pas encore nettoyé bien sûr

n°2315327
dje69r
Arme de distraction massive
Posté le 15-05-2018 à 16:27:40  profilanswer
 

Quelle version d'Excel ?
Fichier xlsm ?
Sécurité des macros et emplacements approuvés ?


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
mood
Publicité
Posté le 15-05-2018 à 16:27:40  profilanswer
 

n°2315328
liln
Posté le 15-05-2018 à 16:30:11  profilanswer
 

dje69r a écrit :

Quelle version d'Excel ?
Fichier xlsm ?
Sécurité des macros et emplacements approuvés ?


 
-Excel 2010
-oui Xlsm
-Tout approuvé
je t'ai envoyé le fichier en MP :jap:  
 
 

n°2315331
liln
Posté le 15-05-2018 à 16:42:05  profilanswer
 

sinon le lien


Message édité par liln le 17-05-2018 à 16:53:59
n°2315335
dje69r
Arme de distraction massive
Posté le 15-05-2018 à 17:06:04  profilanswer
 

Ok, vu l'erreur

 

Tout ce qui est Workbook_Open ou BeforeClose etc. ce sont des noms de fonctions réservées
Ces codes ne sont pas à mettre dans Module1 mais dans ThisWorkbook (en dessous de Feuil9) sur la gauche dans la liste des modules

Message cité 1 fois
Message édité par dje69r le 15-05-2018 à 17:09:12

---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
n°2315336
liln
Posté le 15-05-2018 à 18:11:30  profilanswer
 

dje69r a écrit :

Ok, vu l'erreur
 
Tout ce qui est Workbook_Open ou BeforeClose etc. ce sont des noms de fonctions réservées
Ces codes ne sont pas à mettre dans Module1 mais dans ThisWorkbook (en dessous de Feuil9) sur la gauche dans la liste des modules


 
Mais oui!! en effet!! InputBox à l'ouverture sur du vierge ok!!
 
par contre il m'ouvre quand même toutes les pages quelque soit le user identifié Grrrr!!!

n°2315337
liln
Posté le 15-05-2018 à 18:23:10  profilanswer
 

De plus quand j'annule la demande d'identifiant il m'ouvre toutes les feuilles par défaut et donc sans restriction :cry:

n°2315427
dje69r
Arme de distraction massive
Posté le 17-05-2018 à 16:08:13  profilanswer
 

J't'ai renvoyé ton fichier en mp


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
n°2315499
patrice337​40
Avec la réponse, c'est facile.
Posté le 21-05-2018 à 00:27:46  profilanswer
 

liln a écrit :

Bonjour je déterre un vieux sujet je sais mais qui correspond parfaitement à mon besoin actuel c-a-d ouvrir des onglets spécifiques selon le user identifié après avoir défini les droits de chacun en amont.
 
j'ai donc généreusement copié le code plus haut mais j'ai encore une erreur de compilation: 2 petites erreurs de syntaxe qui traînent et impossible de mettre le doigt dessus!! HELP
 


 
Mal plutôt que généreusement !
 
Il manque un End If et un End Sub !


---------------
Cordialement, Patrice
n°2315500
liln
Posté le 21-05-2018 à 00:54:00  profilanswer
 

patrice33740 a écrit :


 
Mal plutôt que généreusement !
 
Il manque un End If et un End Sub !


 
Merci vu avec dje69r et ça fonctionne  :jap:  

n°2318501
acualyisdo​lan
Flotte mais jamais ne sombre
Posté le 31-07-2018 à 17:40:30  profilanswer
 

Salut,
Si ça intéresse quelqu'un j'ai fait un système du genre (restriction onglet à base de feuilles de tri). Me MP.
Attention code dégueulasse mais bon, ça marche.  [:acualyisdolan]


---------------
Sondage pharmacien@HFR ici : https://goo.gl/forms/7cIJiIFNm0lKGOfm1
n°2318718
antac
..
Posté le 05-08-2018 à 10:42:44  profilanswer
 

Question con, si les données sont chargées dans tous les fichiers à la base et qu'on ouvre avec Libreoffice ou qu'on désactive les macros... ça donne quoi ?


Message édité par antac le 05-08-2018 à 10:43:04
n°2325360
ph71
Posté le 04-12-2018 à 10:38:52  profilanswer
 

dje69r a écrit :

J't'ai renvoyé ton fichier en mp


 
Bonjour dje69r,
 
Je viens de lire tout ce bon code page 1 et l'adapter pour moi.
Vraiment merci pour ce travail !
 
Mais j'ai le même problème que la personne qui a écrit ceci :
"De plus quand j'annule la demande d'identifiant il m'ouvre toutes les feuilles par défaut et donc sans restriction"
 
Je cherche mais en vain ce qu'il faudrait ajouter pour éviter que si l'utilisateur clique sur annuler sur les 2 imputBox les onglets restent invisibles mis a part la page vierge ou alors que cela me ferme le classeur au 2ème Annuler... aussi le fait que si on met un faux mot de passe, tous les onglets apparaissent. Peut-on sécuriser le classeur en l'obligeant à se fermer ?
Pourriez-vous m'aider svp ?
Merci


Message édité par ph71 le 04-12-2018 à 10:53:37
n°2325464
dje69r
Arme de distraction massive
Posté le 05-12-2018 à 07:24:02  profilanswer
 

Salut ph71
 
Je regarde dans la journée, le lien pour liln a expiré
Tu as pris le code de liln quelques posts plus haut ?


---------------
Debout les campeurs et haut les cœurs, n’oublier pas vos bottes parce que ça caille aujourd’hui. Ça caille tous les jours par ici, on n’est pas a Miami ! On en est même loin ! C'est le JOUR DE LA MARMOTTE !
n°2325469
ph71
Posté le 05-12-2018 à 10:35:38  profilanswer
 

dje69r a écrit :

Salut ph71
 
Je regarde dans la journée, le lien pour liln a expiré
Tu as pris le code de liln quelques posts plus haut ?


 
Bonjour,
Oui, c'est ce que j'ai fais.  
Je voudrais t'envoyer le fichier en MP mais je ne sais pas comment faire.
C'est sympa de m'aider.
Merci

n°2328868
johann_c21
Posté le 06-02-2019 à 23:30:53  profilanswer
 

acualyisdolan a écrit :

Salut,
Si ça intéresse quelqu'un j'ai fait un système du genre (restriction onglet à base de feuilles de tri). Me MP.
Attention code dégueulasse mais bon, ça marche.  [:acualyisdolan]


 
Bonjour,
 
Je suis bien intéressé par ton système,  
En effet je voudrais pouvoir donner accès de façon restrictive (confidentialité et simplicité) à un User sur un tableur de données en fonction de son code User et via l'introduction d'un mot de passe.  
Ou
Comble de la perfection,  
En fonction de son identité, lié à son profil (le nom qui s'affiche lorsque la personne sauvegarde en dernier).
 
Est-ce que c'est possible de faire une table de correspondance permettant de donner accès selon l'un de ces deux mode op' ?
 
Merci  
 
Johann

n°2329409
pass-by
Posté le 19-02-2019 à 16:00:54  profilanswer
 

Très malin comme système. Juste par souci de précision, c'est pas très compliqué à pirater comme système même avec un classeur protégé et du vba protégé ;)

n°2330217
acualyisdo​lan
Flotte mais jamais ne sombre
Posté le 09-03-2019 à 10:48:12  profilanswer
 

johann_c21 a écrit :


 
Bonjour,
 
Je suis bien intéressé par ton système,  
En effet je voudrais pouvoir donner accès de façon restrictive (confidentialité et simplicité) à un User sur un tableur de données en fonction de son code User et via l'introduction d'un mot de passe.  
Ou
Comble de la perfection,  
En fonction de son identité, lié à son profil (le nom qui s'affiche lorsque la personne sauvegarde en dernier).
 
Est-ce que c'est possible de faire une table de correspondance permettant de donner accès selon l'un de ces deux mode op' ?
 
Merci  
 
Johann


Mouaip.
Je retrouve mon doc, et repose ici un peu de code.


---------------
Sondage pharmacien@HFR ici : https://goo.gl/forms/7cIJiIFNm0lKGOfm1
n°2330218
acualyisdo​lan
Flotte mais jamais ne sombre
Posté le 09-03-2019 à 11:01:02  profilanswer
 

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. :o

 

Contenu de ThisWorkbook (trucs qui s'exécutent à chaque démarrage du fichier) :

Code :
  1. Public Droit_Admin As Boolean
  2. Private Sub Workbook_BeforeClose(Cancel As Boolean)
  3.    
  4.     ' Lors de la fermeture du fichier, passage des feuilles en statut caché
  5.     For Each ws In ActiveWorkbook.Worksheets:
  6.         If ws.Name <> "Menu" Then
  7.             ws.Visible = xlVeryHidden
  8.         End If
  9.     Next ws
  10.    
  11.     ' Mise en lecture seule par l'appel de la fonction ToggleSheetProtection
  12.     Call ToggleSheetProtection
  13.    
  14.     ' Sauvegarde la feuille
  15.     For Each wb In Application.Workbooks:
  16.         wb.Save
  17.     Next wb
  18.    
  19. End Sub
  20. Private Sub Workbook_NewSheet(ByVal Sh As Object)
  21.     ' Empêche l'utilisateur de créer un onglet si la variable Admin est sur False
  22.     If Droit_Admin = False Then
  23.         Application.ScreenUpdating = False
  24.         Application.DisplayAlerts = False
  25.             Sh.Delete
  26.             MsgBox ("Interdiction de créer une nouvelle feuille de calcul." & vbCr & _
  27.                 "Demander à l'administrateur de la feuille de calcul de rajouter une feuille." )
  28.          
  29.         Application.DisplayAlerts = True
  30.         Application.ScreenUpdating = True
  31.    
  32.     Else
  33.         ' Mise à jour de la table des droits d'accès
  34.         Call Maj_Liste_Acces_Ajout
  35.        
  36.         ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
  37.         Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
  38.         Set StartCell_access = Range("A1" )
  39.    
  40.         LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
  41.             StartCell_access.Column).End(xlUp).Row
  42.        
  43.         LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
  44.             liste_access.Columns.Count).End(xlToLeft).Column
  45.    
  46.         ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  47.         Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  48.         Set StartCell_Pass = Range("A1" )
  49.        
  50.         LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  51.             StartCell_Pass.Column).End(xlUp).Row
  52.            
  53.         LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  54.             Liste_pass.Columns.Count).End(xlToLeft).Column
  55.            
  56.         ' Ajout des droits au compte admin
  57.         row_val = 0
  58.         col_val = 0
  59.        
  60.         For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
  61.            
  62.             If CStr(cell.Value) = CStr(Sh.Name) Then
  63.                 col_val = cell.Column
  64.             End If
  65.            
  66.         Next cell
  67.        
  68.         For Each cell In Range(liste_access.Cells(2, 1), liste_access.Cells(LastRow_Access, 1)):
  69.            
  70.             If CStr(cell.Value) = "Admin" Then
  71.                 row_val = cell.Row
  72.             End If
  73.            
  74.         Next cell
  75.         If row_val <> 0 And col_val <> 0 Then
  76.             liste_access.Cells(row_val, col_val).Value = "X"
  77.         End If
  78.     End If
  79.    
  80. 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 :
  1. Public Sub Worksheet_Activate()
  2.     ' Quand l'onglet menu s'affiche on met à jour la liste des accès
  3.     ' En appelant la fonction pour cela
  4.     ' (Mesure de précaution)
  5.     Call Maj_Liste_Acces_Ajout
  6.     Call Maj_Liste_Access_Supr
  7.     ThisWorkbook.Droit_Admin = False
  8. End Sub
 

Module 1:

Code :
  1. Public Sub Mdp_Verif()
  2.     ' Déclaration des 2 variables booléennes
  3.     ' Une pour vérifier si le mdp existe
  4.     ' L'autre pour terminer une boucle while
  5.    
  6.     Dim mdp_exist As Boolean
  7.     Dim loop_state As Boolean
  8.    
  9.     ' Détermination des dimensions de la feuille de calcul des mdp
  10.     Set ws_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  11.     Set StartCell_Pass = Range("A1" )
  12.    
  13.     LastRow_pass = ws_pass.Cells(ws_pass.Rows.Count, _
  14.     StartCell_Pass.Column).End(xlUp).Row
  15.    
  16.     LastColumn_Pass = ws_pass.Cells(StartCell_Pass.Column, _
  17.     ws_pass.Columns.Count).End(xlToLeft).Column
  18.    
  19.     ' On définit le nombre d'essai a 3 et la variable booléene sur True
  20.     ' Si loop_state passe sur false on stoppe la boucle while
  21.    
  22.     loop_state = True
  23.     nb_essai = 3
  24.    
  25.     ' boucle while d'entrée du mot de passe par inputbox
  26.     ' Doit tourner 3 foix max, après loop_state passe a false
  27.    
  28.     While loop_state = True
  29.        
  30.         ' Demande du mot de passe
  31.         input_mdp = InputBoxDK("Entrez votre mot de passe : " )
  32.        
  33.         ' Si l'utilisateur click sur cancel, on stop la fonction
  34.         If input_mdp = vbNullString Then
  35.             Exit Sub
  36.        
  37.         ' Sinon on continue
  38.         Else
  39.             ' On définit initialement la variable a False
  40.             mdp_exist = False
  41.            
  42.             ' Boucle pour balayer la colonne mot de passe
  43.             For j = 2 To LastRow_pass:
  44.                    
  45.                 ' Si le mot de passe est présent dans la colonne
  46.                 ' On met mdp_exist sur True et on termine la boucle for
  47.                 If ws_pass.Cells(j, 2).Value = input_mdp Then
  48.                     mdp_exist = True
  49.                     Exit For
  50.                    
  51.                 ' Sinon on continue à définir mdp_exist comme False
  52.                 Else
  53.                     mdp_exist = False
  54.                 End If
  55.                
  56.             Next j
  57.            
  58.             ' Si mdp_exist est sur True alors on va vérifier les droits d'accès
  59.             ' Avec la fonction Verif_Droits(on passe le mdp en argument
  60.             ' Et on termine la boucle while en mettant loop_state a False
  61.             If mdp_exist = True Then
  62.                 Call Verif_Droits(CStr(input_mdp))
  63.                 loop_state = False
  64.            
  65.             ' Sinon on cache tout (au cas ou, en principe déjà caché)
  66.             ' Et on décrémente notre compteur nb_essai de 1
  67.             ' Si il tombe a 0 on passe loop_state à False pour terminer la boucle
  68.            
  69.             ElseIf mdp_exist = False Then
  70.                 For Each ws In ActiveWorkbook.Worksheets:
  71.                     If ws.Name <> "Menu" Then
  72.                         ws.Visible = xlVeryHidden
  73.                     End If
  74.                 Next ws
  75.                
  76.                 nb_essai = nb_essai - 1
  77.                
  78.                 If nb_essai = 0 Then
  79.                     loop_state = False
  80.                    
  81.                 ' Si mdp_exist est False en plus de décrémenter
  82.                 ' On met un message d'erreur affichant le nombre d'essai restant
  83.                
  84.                 Else
  85.                     MsgBox ("Mot de passe incorrect, veuillez essayer à nouveau" _
  86.                     & vbCr & "[" & nb_essai & "] essais restant." )
  87.                 End If
  88.                
  89.             End If
  90.                
  91.         End If
  92.        
  93.     Wend
  94.    
  95. End Sub
  96. Public Sub Verif_Droits(mdp As String)
  97.     ' Vérifier les pages que la personne associée au mot de passe a
  98.     ' Et afficher les pages en correspondance
  99.    
  100.     ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  101.     Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  102.     Set StartCell_Pass = Range("A1" )
  103.    
  104.     LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  105.         StartCell_Pass.Column).End(xlUp).Row
  106.        
  107.     LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  108.         Liste_pass.Columns.Count).End(xlToLeft).Column
  109.        
  110.     ' Compare le mdp a la colonne mdp de la feuille de calcul
  111.     ' Retourne le nom de la personne
  112.     Count = 0
  113.     last_i = 2
  114.     For i = 2 To LastRow_pass:
  115.         If CStr(mdp) = CStr(Liste_pass.Cells(i, 2).Value) Then
  116.             nom_pers = CStr(Liste_pass.Cells(i, 1).Value)
  117.             Count = Count + 1
  118.             last_i = i
  119.             Exit For
  120.         End If
  121.     Next i
  122.    
  123.     ' Boucle For pour compter si il y a des occurence après la dernière trouvée
  124.     ' Permet de vérifier si plusieurs utilisateurs ont le même pass, cf. plus bas)
  125.     For l = last_i + 1 To LastRow_pass:
  126.         If CStr(mdp) = CStr(Liste_pass.Cells(l, 2).Value) Then
  127.             Count = Count + 1
  128.         End If
  129.     Next l
  130.    
  131.     ' Prévention d'un PEBCAK : on signale via le counter (>1)
  132.     ' Si plusieurs utilisateurs ont le même mdp
  133.     ' Le Exit For précédent permet de stopper la boucle après la première occurrence
  134.     ' Et le second If compte les occurrences suivantes s'il y a
  135.    
  136.     If Count > 1 Then
  137.         MsgBox ("Attention ! Plusieurs personnes ont le même mot de passe." & vbCr & _
  138.         "Sélection de la première dans la liste" )
  139.     End If
  140.      
  141.     ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
  142.     Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
  143.     Set StartCell_access = Range("A1" )
  144.    
  145.     LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
  146.         StartCell_access.Column).End(xlUp).Row
  147.        
  148.     LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
  149.         liste_access.Columns.Count).End(xlToLeft).Column
  150.    
  151.     ' Affichage des feuilles de calcul en fonction des droits
  152.     ' Pour l'utilisateur on balaie la ligne, si une case est non nulle
  153.     ' On récupère le nom de la première ligne de cette colonne (nom de la feuille a afficher)
  154.     ' Et on affiche la feuille correspondante
  155.     ' On stocke dans une chaine "liste_acces" les noms des feuilles accessibles à la personne
  156.     ' Pour ensuite enregistrer cette information dans l'audit trail
  157.     liste_acces = ""
  158.     For j = 2 To LastRow_Access:
  159.         If nom_pers = liste_access.Cells(j, 1) Then
  160.             For k = 2 To LastColumn_Access:
  161.                 If liste_access.Cells(j, k).Value <> vbblank Then
  162.                
  163.                     ' On rend la feuille visible
  164.                     Sheets(liste_access.Cells(1, k).Value).Visible = True
  165.                     liste_acces = liste_acces & "   " & liste_access.Cells(1, k).Value
  166.                 End If
  167.            
  168.             Next k
  169.            
  170.             Exit For
  171.        
  172.         End If
  173.        
  174.     Next j
  175.    
  176.     ' Si droits admin, on passe la variable globale à True
  177.     If Sheets("Admin" ).Visible = xlSheetVisible Then
  178.         ThisWorkbook.Droit_Admin = True
  179.     Else
  180.         ThisWorkbook.Droit_Admin = False
  181.     End If
  182.        
  183.     ' Appel de la fonction Audit Trail
  184.     ' En argument, l'utilisateur qui se login et sa liste d'accès
  185.     Call Aj_Audit_Trail(CStr(nom_pers), CStr(liste_acces))
  186.    
  187. End Sub
  188. Public Sub Ajout_Feuille_Calcul_Admin()
  189.     ' Permet de rajouter une feuille de calcul au click
  190.    
  191.     ' Si droits admin, on passe la variable globale à True
  192.     If Sheets("Admin" ).Visible = xlSheetVisible Then
  193.         ThisWorkbook.Droit_Admin = True
  194.     Else
  195.         ThisWorkbook.Droit_Admin = False
  196.     End If
  197.    
  198.     If ThisWorkbook.Droit_Admin = True Then
  199.         ' Déclaration d'une table avec les nom des feuilles de calcul existante
  200.         Dim tab_nom_feuille() As String
  201.         ReDim tab_nom_feuille(0 To 1)
  202.        
  203.         i = 0
  204.         ' On renseigne la table
  205.         For Each ws In ActiveWorkbook.Worksheets:
  206.             tab_nom_feuille(i) = ws.Name
  207.             ReDim Preserve tab_nom_feuille(0 To i + 1)
  208.             i = i + 1
  209.         Next ws
  210.        
  211.         ' Demande du nom à donner à la feuille
  212.         nom_feuille_a_ajouter = InputBox("Rentrer le nom de la table à ajouter :" )
  213.            
  214.         ' Si l'utilisateur click sur cancel, on stoppe la fonction
  215.         If nom_feuille_a_ajouter = vbNullString Then
  216.             Exit Sub
  217.            
  218.         ' Sinon on teste si ce nom existe déjà
  219.         Else
  220.             If IsInArray(CStr(nom_feuille_a_ajouter), tab_nom_feuille) = True Then
  221.                 MsgBox ("Une feuille portant ce nom existe déjà." )
  222.                 Exit Sub
  223.             Else
  224.                 Sheets.Add(Before:=Worksheets("Table_Mot_De_Passe" )).Name = CStr(nom_feuille_a_ajouter)
  225.             End If
  226.            
  227.             ' Mise à jour de la table des droits d'accès
  228.             Call Maj_Liste_Acces_Ajout
  229.            
  230.             ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
  231.             Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
  232.             Set StartCell_access = Range("A1" )
  233.        
  234.             LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
  235.                 StartCell_access.Column).End(xlUp).Row
  236.            
  237.             LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
  238.                 liste_access.Columns.Count).End(xlToLeft).Column
  239.        
  240.             ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  241.             Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  242.             Set StartCell_Pass = Range("A1" )
  243.            
  244.             LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  245.                 StartCell_Pass.Column).End(xlUp).Row
  246.                
  247.             LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  248.                 Liste_pass.Columns.Count).End(xlToLeft).Column
  249.                
  250.             ' Ajout des droits au compte admin
  251.             row_val = 0
  252.             col_val = 0
  253.            
  254.             For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
  255.                
  256.                 If CStr(cell.Value) = CStr(nom_feuille_a_ajouter) Then
  257.                     col_val = cell.Column
  258.                 End If
  259.                
  260.             Next cell
  261.            
  262.             For Each cell In Range(liste_access.Cells(2, 1), liste_access.Cells(LastRow_Access, 1)):
  263.                
  264.                 If CStr(cell.Value) = "Admin" Then
  265.                     row_val = cell.Row
  266.                 End If
  267.                
  268.             Next cell
  269.             If row_val <> 0 And col_val <> 0 Then
  270.                 liste_access.Cells(row_val, col_val).Value = "X"
  271.             End If
  272.         End If
  273.    
  274.     End If
  275. End Sub
 

Module 2

Code :
  1. ' Module contenant les diverse fonctions des boutons d'accès
  2. Public Sub Btn_Access_Tab()
  3.     ' Précaution, on met les droits admin à False
  4.     ThisWorkbook.Droit_Admin = False
  5.    
  6.     ' Au cas ou la feuille soit déjà ouverte avec un autre utilisateur
  7.     ' Au click sur le bouton on "delog" ce dernier en cachant toutes les feuilles
  8.     For Each ws In ActiveWorkbook.Worksheets:
  9.         If ws.Name <> "Menu" Then
  10.             ws.Visible = xlVeryHidden
  11.         End If
  12.     Next ws
  13.    
  14.     ' Mise en lecture seule par l'appel de la fonction ToggleSheetProtection
  15.     Call ToggleSheetProtection
  16.    
  17.     For Each wb In Application.Workbooks:
  18.         wb.Save
  19.     Next wb
  20.    
  21.     ' Appel de la fonction de vérification du mdp
  22.     Call Mdp_Verif
  23.    
  24. End Sub
  25. Public Sub Btn_Access_Mdp()
  26.     ' Ouvre la feuille "Table_Mot_De_Passe" (bouton admin uniquement)
  27.     ActiveWorkbook.Worksheets("Table_Mot_De_Passe" ).Activate
  28. End Sub
  29. Public Sub Btn_Access_Droits()
  30.     ' Ouvre la feuille "Table_Droits_Lecture_Feuilles" (bouton admin uniquement)
  31.     ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" ).Activate
  32. End Sub
  33. Public Sub Btn_Access_Admin()
  34.     ' Ouvre la feuille "Admin" (bouton admin uniquement)
  35.     ActiveWorkbook.Worksheets("Admin" ).Activate
  36. End Sub
  37. Public Sub Btn_Access_Menu()
  38.     ' Ouvre la feuille "Menu"
  39.     ActiveWorkbook.Worksheets("Menu" ).Activate
  40. End Sub
  41. Public Sub Btn_ToggleSheetProtection()
  42.     Call ToggleSheetProtection
  43. End Sub
  44. Public Sub Btn_Ajout_Feuille()
  45.     Call Ajout_Feuille_Calcul_Admin
  46. End Sub
  47. Public Sub Btn_Rm_Protec()
  48.     Call RemoveSheetProtection
  49. End Sub
 

Module 3 :

Code :
  1. ' Fonction pour mettre à jour, à chaque sélection de l'onglet "menu", la liste des accès
  2. Public Sub Maj_Liste_Acces_Ajout()
  3.     ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
  4.     Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
  5.     Set StartCell_access = Range("A1" )
  6.    
  7.     LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
  8.         StartCell_access.Column).End(xlUp).Row
  9.        
  10.     LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
  11.         liste_access.Columns.Count).End(xlToLeft).Column
  12.    
  13.     ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  14.     Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  15.     Set StartCell_Pass = Range("A1" )
  16.    
  17.     LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  18.         StartCell_Pass.Column).End(xlUp).Row
  19.        
  20.     LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  21.         Liste_pass.Columns.Count).End(xlToLeft).Column
  22.        
  23.     ' Définition tableau liste de personnes dans table d'accès existante
  24.     Dim tab_pers() As String
  25.     ReDim tab_pers(0 To 1)
  26.    
  27.     ' Définition tableau liste de feuilles dans table d'accès existante
  28.     Dim tab_feuilles() As String
  29.     ReDim tab_feuilles(0 To 1)
  30.    
  31.     ' Récupération de la liste des personnes (colonne 1 feuille mdp)
  32.     val_tab = 0
  33.     For Each cell In Range(Liste_pass.Cells(2, 1), Liste_pass.Cells(LastRow_pass, 1)):
  34.         tab_pers(val_tab) = cell.Value
  35.         ReDim Preserve tab_pers(0 To val_tab + 1)
  36.         val_tab = val_tab + 1
  37.     Next cell
  38.        
  39.     ' Récupération de la liste des onglets
  40.     val_tab = 0
  41.     For Each ws In ActiveWorkbook.Worksheets:
  42.         If ws.Name <> "Menu" Then
  43.             tab_feuilles(val_tab) = ws.Name
  44.             ReDim Preserve tab_feuilles(0 To val_tab + 1)
  45.             val_tab = val_tab + 1
  46.         End If
  47.     Next ws
  48.    
  49.    
  50.     ' Chaine qui concatène les noms de la ligne
  51.     pers_presentes_dans_feuille_droits = ""
  52.    
  53.     For i = 2 To LastRow_Access:
  54.         If liste_access.Cells(i, 1).Value <> vbblank Then
  55.             pers_presentes_dans_feuille_droits = pers_presentes_dans_feuille_droits & liste_access.Cells(i, 1).Value
  56.         End If
  57.     Next i
  58.    
  59.     ' Chaine qui concatène les noms des feuilles présente dans la feuille de calcul droit
  60.     feuilles_presentes_dans_feuille_droits = ""
  61.    
  62.     For j = 2 To LastColumn_Access:
  63.         If liste_access.Cells(1, j).Value <> vbblank Then
  64.             feuilles_presentes_dans_feuille_droits = feuilles_presentes_dans_feuille_droits & liste_access.Cells(1, j).Value
  65.         End If
  66.     Next j
  67.    
  68.     ' Fonction InStr pour comparer les chaines générées au contenu du tableau personne
  69.      For i = 0 To UBound(tab_pers) - 1:
  70.             ' Cas ou la colonne est vide
  71.             If pers_presentes_dans_feuille_droits = "" Then
  72.                 liste_access.Cells(LastRow_Access + 1, 1).Value = tab_pers(i)
  73.                 LastRow_Access = LastRow_Access + 1
  74.                
  75.             ' Autre cas : si on a une occurence qui sort avec Instr, on teste chaque valeur
  76.             ' La boucle For, si tombe sur une égalité de valeur entre l'entrée du tableau et la colonne
  77.             ' Termine la boucle et incrémente val_pres
  78.             ' Une entrée est rajoutée uniquement si val_pres est nulle (autrement l'entrée est déjà presente)
  79.            
  80.             ElseIf InStr(1, pers_presentes_dans_feuille_droits, tab_pers(i), vbTextCompare) <= 1 Then
  81.                
  82.                 val_pres = 0
  83.                 For k = 2 To LastRow_Access:
  84.                     If liste_access.Cells(k, 1).Value = tab_pers(i) Then
  85.                         k = LastRow_Access
  86.                         val_pres = val_pres + 1
  87.                     End If
  88.                 Next k
  89.                
  90.                 If val_pres = 0 Then
  91.                     liste_access.Cells(LastRow_Access + 1, 1).Value = tab_pers(i)
  92.                     LastRow_Access = LastRow_Access + 1
  93.                 End If
  94.                
  95.             End If
  96.      Next i
  97.    
  98.      ' Fonction InStr pour comparer les chaines générées au contenu du tableau feuilles
  99.      For j = 0 To UBound(tab_feuilles) - 1:
  100.         If feuilles_presentes_dans_feuille_droits = "" Then
  101.             liste_access.Cells(1, LastColumn_Access + 1).Value = tab_feuilles(j)
  102.             LastColumn_Access = LastColumn_Access + 1
  103.            
  104.         ElseIf InStr(1, feuilles_presentes_dans_feuille_droits, tab_feuilles(j), vbTextCompare) = 0 Then
  105.             liste_access.Cells(1, LastColumn_Access + 1).Value = tab_feuilles(j)
  106.             LastColumn_Access = LastColumn_Access + 1
  107.         End If
  108.      Next j
  109.        
  110. End Sub
  111. Public Sub Maj_Liste_Access_Supr()
  112.     ' Supprime de la feuille de calcul "Table_Droits_Lecture_Feuilles"
  113.     ' Les entrées qui ne sont pas dans la liste des mots de passe/les feuilles de calcul
  114.    
  115.     ' Définition de la feuille de calcul avec liste d'accès et détermination de ses dimensions
  116.     Set liste_access = ActiveWorkbook.Worksheets("Table_Droits_Lecture_Feuilles" )
  117.     Set StartCell_access = Range("A1" )
  118.    
  119.     LastRow_Access = liste_access.Cells(liste_access.Rows.Count, _
  120.         StartCell_access.Column).End(xlUp).Row
  121.        
  122.     LastColumn_Access = liste_access.Cells(StartCell_access.Column, _
  123.         liste_access.Columns.Count).End(xlToLeft).Column
  124.    
  125.     ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  126.     Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  127.     Set StartCell_Pass = Range("A1" )
  128.    
  129.     LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  130.         StartCell_Pass.Column).End(xlUp).Row
  131.        
  132.     LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  133.         Liste_pass.Columns.Count).End(xlToLeft).Column
  134.        
  135.     ' Définition tableau liste de personnes dans table d'accès existante
  136.     Dim tab_pers() As String
  137.     ReDim tab_pers(0 To 1)
  138.    
  139.     ' Définition tableau liste de feuilles dans table d'accès existante
  140.     Dim tab_feuilles() As String
  141.     ReDim tab_feuilles(0 To 1)
  142.    
  143.     ' Récupération de la liste des personnes (colonne 1 feuille mdp)
  144.     val_tab = 0
  145.     For Each cell In Range(Liste_pass.Cells(2, 1), Liste_pass.Cells(LastRow_pass, 1)):
  146.         tab_pers(val_tab) = cell.Value
  147.         ReDim Preserve tab_pers(0 To val_tab + 1)
  148.         val_tab = val_tab + 1
  149.     Next cell
  150.        
  151.     ' Récupération de la liste des onglets
  152.     val_tab = 0
  153.     For Each ws In ActiveWorkbook.Worksheets:
  154.         If ws.Name <> "Menu" Then
  155.             tab_feuilles(val_tab) = ws.Name
  156.             ReDim Preserve tab_feuilles(0 To val_tab + 1)
  157.             val_tab = val_tab + 1
  158.         End If
  159.     Next ws
  160.    
  161.     ' Boucle sur la première colonne de la feuille "Table_Droits_Lecture_Feuilles"
  162.     ' On regarde si la valeur est dans le tableau tab_pers
  163.     ' Si l'entrée n'y est pas, on la supprime
  164.     For i = 2 To LastRow_Access:
  165.         If IsInArray(CStr(Cells(i, 1).Value), tab_pers) = False Then
  166.             liste_access.Rows(i).EntireRow.Delete
  167.             i = i - 1
  168.         End If
  169.     Next i
  170.        
  171.     ' Boucle sur la première ligne de la feuille "Table_Droits_Lecture_Feuilles"
  172.     ' On regarde si la valeur est dans le tableau tab_feuille
  173.     ' Si l'entrée n'y est pas, on la supprime
  174.     For Each cell In Range(liste_access.Cells(1, 2), liste_access.Cells(1, LastColumn_Access)):
  175.         If IsInArray(CStr(cell.Value), tab_feuilles) = False Then
  176.             liste_access.Columns(cell.Column).EntireColumn.Delete
  177.         End If
  178.     Next cell
  179.    
  180. End Sub
 

Module 4

Code :
  1. Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  2.     ' Pris sur https://stackoverflow.com/questions/38267950/check-if-a-value-is-in-an-array-or-not-with-excel-vba
  3.     Dim i
  4.     For i = 0 To UBound(arr)
  5.         If arr(i) = stringToBeFound Then
  6.             IsInArray = True
  7.             Exit Function
  8.         End If
  9.     Next i
  10.     IsInArray = False
  11.    
  12. End Function
  13. Public Sub ToggleSheetProtection()
  14.     ' Idée prise sur https://superuser.com/questions/914 [...] a-password
  15.  
  16.     ' Définition d'un tableau avec le nom des feuilles à exclure
  17.     Dim tab_nom_exc() As String
  18.     ReDim tab_nom_exc(0 To 4)
  19.         tab_nom_exc(0) = "Admin"
  20.         tab_nom_exc(1) = "Table_Mot_De_Passe"
  21.         tab_nom_exc(2) = "Table_Droits_Lecture_Feuilles"
  22.         tab_nom_exc(3) = "Menu"
  23.         tab_nom_exc(4) = "Audit_Trail"
  24.    
  25.     ' Définition de la feuille de calcul avec les mots de passe et détermination de ses dimensions
  26.     Set Liste_pass = ActiveWorkbook.Worksheets("Table_Mot_De_Passe" )
  27.     Set StartCell_Pass = Range("A1" )
  28.    
  29.     LastRow_pass = Liste_pass.Cells(Liste_pass.Rows.Count, _
  30.         StartCell_Pass.Column).End(xlUp).Row
  31.        
  32.     LastColumn_Pass = Liste_pass.Cells(StartCell_Pass.Column, _
  33.         Liste_pass.Columns.Count).End(xlToLeft).Column
  34.        
  35.     ' Compare le login Admin a la colonne mdp de la feuille de calcul
  36.     ' Retourne le mdp
  37.     Count = 0
  38.     For i = 1 To LastRow_pass:
  39.         If CStr("Admin" ) = CStr(Liste_pass.Cells(i, 1).Value) Then
  40.             mdp_admin = CStr(Liste_pass.Cells(i, 2).Value)
  41.             Exit For
  42.         End If
  43.     Next i
  44.  
  45.  
  46.    ' Met ou enlève la protection sur les feuilles de calcul
  47.    ' Qui sont dans le tableau défini juste avant
  48.    ' Le mot de passe est celui de l'admin trouvé par la boucle précédente
  49.    For Each ws In ActiveWorkbook.Worksheets:
  50.         If IsInArray(CStr(ws.Name), tab_nom_exc) = False Then
  51.             ws.Protect mdp_admin, True, True, True, True
  52.         End If
  53.     Next ws
  54.    
  55. End Sub
  56. Public Sub RemoveSheetProtection()
  57.     For Each ws In ActiveWorkbook.Worksheets:
  58.         If ws.ProtectContents Then
  59.             ws.Unprotect
  60.         End If
  61.     Next ws
  62. End Sub
 

Module 5

Code :
  1. Option Explicit
  2.     ' InputBox spéciale mot de passe
  3.     ' Pris sur http://www.office-loesung.de/ftopic74191_0_0_asc.php
  4.     'Code geschrieben von Daniel Klann
  5.     Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
  6.     ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
  7.     Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
  8.     Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
  9.     (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
  10.     ByVal dwThreadId As Long) As Long
  11.     Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
  12.     Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
  13.     (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _
  14.     ByVal wParam As Long, ByVal lParam As Long) As Long
  15.     Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
  16.     ByVal lpClassName As String, _
  17.     ByVal nMaxCount As Long) As Long
  18.     Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
  19.     Private Const EM_SETPASSWORDCHAR = &HCC
  20.     Private Const WH_CBT = 5
  21.     Private Const HCBT_ACTIVATE = 5
  22.     Private Const HC_ACTION = 0
  23.     Private hHook As Long
  24. Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  25.     Dim RetVal
  26.     Dim strClassName As String, lngBuffer As Long
  27.     If lngCode < HC_ACTION Then
  28.         NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
  29.         Exit Function
  30.     End If
  31.     strClassName = String$(256, " " )
  32.     lngBuffer = 255
  33.      If lngCode = HCBT_ACTIVATE Then
  34.         RetVal = GetClassName(wParam, strClassName, lngBuffer)
  35.             If Left$(strClassName, RetVal) = "#32770" Then
  36.             SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*" ), &H0
  37.             End If
  38.      End If
  39.     CallNextHookEx hHook, lngCode, wParam, lParam
  40. End Function
  41. Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _
  42.     Optional YPos, Optional HelpFile, Optional Context) As String
  43.     Dim lngModHwnd As Long, lngThreadID As Long
  44.     lngThreadID = GetCurrentThreadId
  45.     lngModHwnd = GetModuleHandle(vbNullString)
  46.     hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)
  47.     InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context)
  48.     UnhookWindowsHookEx hHook
  49. 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 :
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. Dim CommBarTmp, Commbar As CommandBar
  3. For Each Commbar In Application.CommandBars
  4.     Set CommBarTmp = Commbar.FindControl(ID:=847, recursive:=True)
  5.     If Not CommBarTmp Is Nothing Then CommBarTmp.Enabled = False
  6. Next
  7. End Sub



Message édité par acualyisdolan le 09-03-2019 à 11:01:21

---------------
Sondage pharmacien@HFR ici : https://goo.gl/forms/7cIJiIFNm0lKGOfm1
mood
Publicité
Posté le   profilanswer
 

 Page :   1  2
Page Suivante

Aller à :
Ajouter une réponse
 

Sujets relatifs
Creation d'utilisateur dans AD via powershell plus..[script batch] accès à la base de registre
[RESOLU][MySQL] calcul suivant le cas ....Acces aux elements d'une iframe
onglet pour forum [Access] Appliquer filtre à un sous formulaire situé dans un onglet
(résolu) Probleme avec IDLE (manque un onglet)Suppression valeur dans registre suivant une chaine de caractère
Protection d'une page permettant l'accès à une base de données sqlAccès instances de classes...
Plus de sujets relatifs à : Macro Excel : Accès restreint par onglet suivant utilisateur


Copyright © 1997-2018 Hardware.fr SARL (Signaler un contenu illicite) / Groupe LDLC / Shop HFR