Gestion des demandes d'accès

Le 24/04/2021 à 08:43

Bonjour à tous,

Je suis actuellement sur un soucis de gestion d'accès dans mon entreprise.

Afin de faciliter la demande et la gestion d'accès j'ai créer un fichier avec le nom le service et les différents accès.

Ma macro lorsque j'active une case à coché, envoi un mail automatique au service concerné avec en objet le fichier de formation s'il y en a un, le nom de la personne et le service concerné afin que la personne qui reçoive le mail puisse lui octroyer les accès.

Mon soucis aujourd'hui c'est que ses cases à cocher me contraint beaucoup sur l'utilisation quotidienne (impossibilité de faire des tri / filtre automatique sur les personnes recherchés, lourdeur du fichier..)

J'aimerais savoir si vous aviez une solution afin d'avoir quelque chose de plus "fiable" car aujourd'hui si je tri de A à Z ou autre tous mes accès sont mélangés...

je vous transmets en PJ mon fichier

je vous remercie pour votre bienveillance !

Christophe

23listing-acces-et-formation-plasmatest.zip (297.59 Ko)
Le 24/04/2021 à 09:31

Bonjour,

Pourquoi ne pas utiliser un liste de validation pour chaque cellule avec "X" ou rien ? C'est beaucoup plus simple à gérer et moins lourd. On peut avoir une macro événementielle qui à chaque X inscrit sur une plage envoie un mail. Ainsi les croix étant liée au tri, plus de problème.

Mais il faudrait savoir quel est votre besoin exact concernant l’exécution de cette macro :

- A chaque fois qu'un X est inscrit elle se lance -> procédure événementielle qui se lance à chaque fois qu'un X est renseigné
- On peut inscrire un / en prévision de formation, appuyer sur un bouton puis à chaque fois qu'on l'actionne, la macro passe en revue tout les /, envoie le mail et les remplace par un X -> procédure unique qui peut être lancée quand on le souhaite

En gros, il nous faut plus de précision sur le besoin, la méthode de travail et comment vous voyez ce fichier construit avant que je me lance.

Cdlt,

Edit : On pourrait même avoir mieux : l'en tête du tableau avec un hyperlien vers la formation -> lorsqu'un X apparaît, ce lien est inscrit en hyperlien sur ce X. Ca évite les doublons de colonnes. Mais ces liens sont-ils génériques par formation ? Ou spécifique à chaque collaborateur ?

Le 24/04/2021 à 09:56

Bonjour,

Une case à cocher c'est True/False pourquoi X/rein ?

Le 24/04/2021 à 10:16

Bonjour,

Merci pour vos retours,

Concernant mon besoin, j'aimerais que lorsque j'inscrive un X une macro se lance pour qu'on aille chercher dans le réseau la formation effectuée si elle existe (sinon nexter cette étape) puis dans le même ordre que c'est actuellement le cas, faire en sorte que depuis le X en question je complète mon mail avec le nom / le service / le nom de l'accès et le lien vers le fichier si disponible.

Egalement si le lien pouvait remplacer le X a al suite de cette macro ça pourrait etre très utile pour réduire le fichier

Cdlt

Christophe

Le 24/04/2021 à 14:15

Bonjour,

Je n'ai pas arrêté depuis ce matin mais je pense être arrivé à quelque chose d'acceptable au vu de mes compétences (en tout cas j'en suis fier). Certains pourront peut être l'optimiser mais bon ce n'était pas mon objectif :

Option Explicit

Sub ENVOI()
Dim REF As Range, FORM As Range
Dim ACCES() As String
Dim LC%, i%, j%, CORPS$
Dim APPMAIL As Object
Dim OBJMAIL As Object
With Worksheets("Base de donnée")
LC = .Cells(2, .Columns.Count).End(xlToLeft).Column
For Each REF In [A2].CurrentRegion
    If REF = "/" Then
        i = 0
        ReDim ACCES(1, i)
        ACCES(0, i) = "TYPE ACCES"
        ACCES(1, i) = "ACCES"
        For Each FORM In Range(.Cells(REF.Row, 3), .Cells(REF.Row, LC))
            If FORM = "/" Then
                i = i + 1
                ReDim Preserve ACCES(1, i)
                ACCES(0, i) = .Cells(1, FORM.Column)
                ACCES(1, i) = .Cells(2, FORM.Column)
                FORM.Value = "X"
                Worksheets("Base de donnée").Hyperlinks.Add Range(FORM.Address), .Cells(2, FORM.Column).Hyperlinks(1).Address
            End If
        Next FORM
        For j = LBound(ACCES, 1) To UBound(ACCES, 2)
            CORPS = CORPS & "<tr><td style=""border:1px solid black;text-align: center;"">" & ACCES(0, j) & "</td><td style=""border:1px solid black;text-align: center;"">" & ACCES(1, j) & "</td></tr>"
        Next
        Set APPMAIL = CreateObject("outlook.application")
        Set OBJMAIL = APPMAIL.CreateItem(0)
        With OBJMAIL
'                .To = "xxx@xxx.fr"
            .Subject = "Nouvelle demande d'accès Plasma pour le collaborateur " & Worksheets("Base de donnée").Cells(REF.Row, 1)
            .HTMLBody = "<font face=""Calibri""><font size = " & Chr(34) & "3,5" & Chr(34) & "> " & _
                        "Bonjour, nous souhaitons faire une nouvelle demande d'accès pour la personne " & Worksheets("Base de donnée").Cells(REF.Row, 1) & "<br><br>" & _
                        "<table style=""border:1px solid black;border-collapse:collapse;""><tbody>" & CORPS & "</tbody></table><br>" & _
                        "Merci par avance de faire le nécessaire.</font>"
            .Display
        End With
        Erase ACCES
        CORPS = ""
    End If
Next REF
End With
End Sub

Ainsi dans le fichier joint, dès lors que vous placez un "/" dans une cellule, puis que vous cliquez sur générer les mails, un mail est automatiquement généré PAR COLLABORATEUR pour TOUTES LES DEMANDES D'ACCES afin de ne pas spammer le destinataire des mails. Vous conservez tout de même une traçabilité par individu.

Les / sont transformés en X automatiquement et le lien hypertexte présent dans la même colonne à la ligne 2 est ajouté sur votre cellule, même si j'avoue ne pas trop comprendre l'intérêt de ce lien dans les cellules ...

J'espère que cela vous sera utile et vous conviendra.

En tout cas le fichier est beaucoup plus léger et fluide, bien que je suis d'accord j'ai supprimé des données, cela ne devrait pas poser de soucis. Vous n'avez plus besoin du bouton ajout de personne aussi car ils sont automatiquement intégrés à la recherche de cette macro car je cherche toutes les cellules accolées à la cellule A2, que ce soit en ligne ou en colonne.

Cdlt,

11formation.xlsm (24.25 Ko)

Edit : La partie la plus complexe a été de reporter les valeurs chargées dans mon array dans le .HTMLBody Outlook en ayant une mise en page a peu près correcte, ne maîtrisant pas le HTML.

Edit 2 : @dysorthographie : Je ne souhaitais pas passer par une case à cocher mais une liste de validation directement sur la cellule, d'où le X / Rien.

Le 26/04/2021 à 10:23
6listing-acces-et-formation-plasmav4.xlsm (32.62 Ko)

Bonjour Ergotamine,

Et merci pour ton expertise !

Néanmoins je relève deux éléments qui ne fonctionnent pas selon mon besoin.

1- J'ai adapter ton tbaleau à mon utilisation, mais il ne fonctionne pas lorsque j'ajoute des lignes & colonnes

2- Je n'arrive pas a comprendre le fonctionnement du lien hypertexte, chez moi ça ne fonctionne pas car ça ne trouve pas le chemin spécifié, mais comment est-il créé sur quoi se réfère t'il? Mon besoin est de pouvoir pour chaque personne formée ajouter un PDF que j'irais manuellement chercher ( boite de dialogue qui nous permettrait de parcourir le réseau)

Merci d'avance pour ton retour, je te mets en PJ le fichier MAJ selon ma demande

Christophe

Le 26/04/2021 à 11:39

Bonjour,

D'où l'intérêt de correctement définir le besoin dès le début avec le mode de fonctionnement et un maximum de paramètres tel un cahier des charges. Nous aurions pu également partir sur le principe d'avoir le lien du document en ligne 2 et seule la racine change, par exemple avoir en B2 : DOSSIER1/FICHIER.docx mais pour le collaborateur DOSSIER1/FICHIER_COLLABORATEUR.docx afin d'éviter de sélectionner le fichier de formation à chaque fois.

Tout dépend de votre architecture documentaire de votre réseau et du turn over/système de formation mis en place.

Pour votre premier problème je ne le rencontre pas désolé, les dernières lignes colonnes sont bien incluses par l'intermédiaire du code. Dans le cas contraire merci de me donner la référence de la cellule ne fonctionnant pas.

Ci-contre le code modifié :

Sub ENVOI()
Dim REF As Range, FORM As Range
Dim ACCES() As String
Dim LC%, i%, j%, CORPS$, LIEN$
Dim APPMAIL As Object
Dim OBJMAIL As Object
With Worksheets("Base de donnée")
LC = .Cells(2, .Columns.Count).End(xlToLeft).Column
For Each REF In [A2].CurrentRegion
    If REF = "E" Then
        i = 0
        ReDim ACCES(1, i)
        ACCES(0, i) = "TYPE ACCES"
        ACCES(1, i) = "ACCES"
        For Each FORM In Range(.Cells(REF.Row, 3), .Cells(REF.Row, LC))
            If FORM = "E" Then
                i = i + 1
                ReDim Preserve ACCES(1, i)
                ACCES(0, i) = .Cells(1, FORM.Column)
                ACCES(1, i) = .Cells(2, FORM.Column)
                FORM.Value = "X"
                With Application.FileDialog(msoFileDialogFilePicker)
                    .Title = Worksheets("Base de donnée").Cells(REF.Row, 1) & " - " & Worksheets("Base de donnée").Cells(2, FORM.Column)
                    If .Show = -1 Then
                        LIEN = .SelectedItems(1)
                        FORM.Hyperlinks.Add Range(FORM.Address), LIEN
                    End If
                End With
            End If
        Next FORM
        For j = LBound(ACCES, 1) To UBound(ACCES, 2)
            CORPS = CORPS & "<tr><td style=""border:1px solid black;text-align: center;"">" & ACCES(0, j) & "</td><td style=""border:1px solid black;text-align: center;"">" & ACCES(1, j) & "</td></tr>"
        Next
        Set APPMAIL = CreateObject("outlook.application")
        Set OBJMAIL = APPMAIL.CreateItem(0)
        With OBJMAIL
            .To = ""
            .Subject = "Nouvelle demande d'accès Plasma pour le collaborateur " & Worksheets("Base de donnée").Cells(REF.Row, 1)
            .HTMLBody = "<font face=""Calibri""><font size = " & Chr(34) & "3,5" & Chr(34) & "> " & _
                        "Bonjour, nous souhaitons faire une nouvelle demande d'accès pour la personne " & Worksheets("Base de donnée").Cells(REF.Row, 1) & "<br><br>" & _
                        "<table style=""border:1px solid black;border-collapse:collapse;""><tbody>" & CORPS & "</tbody></table><br>" & _
                        "Merci par avance de faire le nécessaire.</font>"
            .Display
        End With
        Erase ACCES
        CORPS = ""
    End If
Next REF
End With
End Sub

Cdlt,

Le 28/04/2021 à 10:11

Bonjour Ergotamine,

Effectivement cette modification répond parfaitement à mon besoin. Je t'en remercie !

J'ai une dernière requête en ajout de ses premiers cahier des charges fastidieux :p

Est-il possible d'ajouter dans le mail l'objet mis en hyperlien?

Merci par avance pour cette modif et merci pour le premier travail déjà établi !

Le 28/04/2021 à 10:43

Bonjour,

Un test qui fonctionne chez moi :

Sub ENVOI()
Dim REF As Range, FORM As Range
Dim ACCES() As String
Dim LC%, i%, j%, CORPS$, LIEN$, HEADER$
Dim APPMAIL As Object
Dim OBJMAIL As Object
With Worksheets("Base de donnée")
    LC = .Cells(2, .Columns.Count).End(xlToLeft).Column
    For Each REF In [A2].CurrentRegion
        If REF = "E" Then
            i = 0
            ReDim ACCES(2, i)
            ACCES(0, i) = "TYPE ACCES"
            ACCES(1, i) = "ACCES"
            ACCES(2, i) = "LIEN"
            HEADER = "<tr><td style=""border:1px solid black;text-align: center;"">" & ACCES(0, 0) & "</td><td style=""border:1px solid black;text-align: center;"">" & ACCES(1, 0) & "</td></tr>"
            For Each FORM In Range(.Cells(REF.Row, 3), .Cells(REF.Row, LC))
                If FORM = "E" Then
                    i = i + 1
                    ReDim Preserve ACCES(2, i)
                    ACCES(0, i) = .Cells(1, FORM.Column)
                    ACCES(1, i) = .Cells(2, FORM.Column)
                    FORM.Value = "X"
                    With Application.FileDialog(msoFileDialogFilePicker)
                        .Title = Worksheets("Base de donnée").Cells(REF.Row, 1) & " - " & Worksheets("Base de donnée").Cells(2, FORM.Column)
                        If .Show = -1 Then
                            LIEN = .SelectedItems(1)
                            FORM.Hyperlinks.Add Range(FORM.Address), LIEN
                            ACCES(2, i) = LIEN
                        End If
                    End With
                End If
            Next FORM
            For j = LBound(ACCES, 1) + 1 To UBound(ACCES, 2)
                CORPS = CORPS & "<tr><td style=""border:1px solid black;text-align: center;"">" & ACCES(0, j) & "</td><td style=""border:1px solid black;text-align: center;""><a href =" & ACCES(2, j) & ">" & ACCES(1, j) & "</a></td></tr>"
            Next
            Set APPMAIL = CreateObject("outlook.application")
            Set OBJMAIL = APPMAIL.CreateItem(0)
            With OBJMAIL
                .To = ""
                .Subject = "Nouvelle demande d'accès Plasma pour le collaborateur " & Worksheets("Base de donnée").Cells(REF.Row, 1)
                .HTMLBody = "<font face=""Calibri""><font size = " & Chr(34) & "3,5" & Chr(34) & "> " & _
                            "Bonjour, nous souhaitons faire une nouvelle demande d'accès pour la personne " & Worksheets("Base de donnée").Cells(REF.Row, 1) & "<br><br>" & _
                            "<table style=""border:1px solid black;border-collapse:collapse;""><tbody>" & HEADER & CORPS & "</tbody></table><br>" & _
                            "Merci par avance de faire le nécessaire.</font>"
                .Display
            End With
            Erase ACCES
            CORPS = ""
        End If
    Next REF
End With
End Sub

Cdlt,

PS : Je vous conseille de regarder vos MP.

Le 03/05/2021 à 14:50

Merci pour ce retour ça fonctionne parfaitement.

Je clos le sujet

Rechercher des sujets similaires à "gestion demandes acces"