Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre habitué
    Fonction pour générer un courriel prenom-compose.nom-compose@ent.fr
    Bonjour
    Je voudrai reconstituer des adresses courriels à partir de NOM Prénom.
    Les noms sont toujours en majuscule
    Les prénoms sont toujours après les noms, sont en minuscules avec la 1ère lettre en majuscule.
    Je peux avoir des caractères accentués dans les noms et les prénoms, ainsi que des apostrophes et des tildés (~)
    Les noms et les prénoms peuvent être composés

    Mon adresse Courriel sera sous la forme prenom-compose.nom-compose@gmail.com

    Je veux bien une macro qui me fasse le tout ou plusieurs fonctions à concaténer dans une feuille de calcul.

    J'ai trouvé une fonction qui remplace les accents, mais je n'arrive pas à la faire fonctionner
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Function suppAccent(chaine As String) As String
    Dim accent As String, sansAccent As String, i As Long
    accent = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    sansAccent = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    For i = 1 To Len(accent)
        chaine = Replace(chaine, Mid(accent, i, 1), Mid(sansAccent, i, 1))
    Next i
    suppAccent = chaine
    End Function

    d'habitude, je saisie dans une cellule =suppAccent(A2), mais ici j'obtiens le résultat #nom

    ensuite, j'ai trouvé une fonction qui récupère le NOM et une autre qui récupère le Prénom
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    Function Nom(ATrouver As String) As String
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "([A-Z]{2,}-* *)+"   
            If .test(ATrouver) Then
        Nom = .Execute(ATrouver)(0)
        End If
    End With
    End Function

    mais elle ne fonctionne pas s'il y a des caractères spéciaux
    Est-ce que quelqu'un peut m'aider, svp.
    MErci

  2. #2
    Expert confirmé
    Bonjour,
    Citation Envoyé par mouftie Voir le message

    J'ai trouvé une fonction qui remplace les accents, mais je n'arrive pas à la faire fonctionner
    Chez moi elle semble fonctionner, j'ai fais qq tests sans soucis, peux tu nous dire quel mot tu as essayé ?


    ensuite, j'ai trouvé une fonction qui récupère le NOM et une autre qui récupère le Prénom
    mais elle ne fonctionne pas s'il y a des caractères spéciaux
    Une fois la première fonction opérationnelle il te suffira de combiner les deux

    edit: l'erreur #nom semble indiqué qu'il ne reconnait pas ta fonction, question con mais t'es sur de ton orthographe ? tu l'as bien mis dans le bon fichier ?
    J'aimerais bien aller vivre en Théorie, car en Théorie tout se passe bien.

  3. #3
    Membre habitué
    Bonjour halaster08,
    Merci pour ta réponse.
    Effectivement, j'ai tout fermé et j'ai recommencé, j'ai pu faire fonctionner la fonction "suppAccent"

    Maintenant, j'ai un pb avec l'autre fonction
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Function Nom(ATrouver As String) As String
    'KO : _ '
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "([A-Z]{2,}-* *)+"
            If .test(ATrouver) Then
        Nom = .Execute(ATrouver)(0)
        End If
    End With
    End Function

    En effet, elle ne prend pas en compte les noms qui comportent une apostrophe ou un underscore ; donc le Nom :
    PARC D'ABOVILLE ou PARC D ABOVILLE ou PARC D_ABOVILLE devient PARC
    J'ai trouvé un tuto pour CreateObject("vbscript.regexp"), mais je n'y arrive pas
    Vois-tu comment rectifier cette fonction ?
    Merci

  4. #4
    Expert confirmé
    Citation Envoyé par mouftie Voir le message

    En effet, elle ne prend pas en compte les noms qui comportent une apostrophe ou un underscore ; donc le Nom :
    PARC D'ABOVILLE ou PARC D ABOVILLE ou PARC D_ABOVILLE devient PARC
    J'ai trouvé un tuto pour CreateObject("vbscript.regexp"), mais je n'y arrive pas
    Je voudrai reconstituer des adresses courriels à partir de NOM Prénom.
    ça existe les adresses mail avec underscore ou apostrophe ?
    Moi je virerais tout ça en plus des accents:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    Function suppAccent(chaine As String) As String
    Dim accent As String, sansAccent As String, i As Long
    accent = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    sansAccent = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    For i = 1 To Len(accent)
        chaine = Replace(chaine, Mid(accent, i, 1), Mid(sansAccent, i, 1))
        chaine = Replace(chaine, "_", "")
        chaine = Replace(chaine, "'", "")
    Next i
    suppAccent = chaine
    End Function


    Sinon désolé je ne maitrise pas assez les expressions régulières pour te dire pourquoi il ne prends pas ces caractères et encore moins comment contourner ce problème.
    J'aimerais bien aller vivre en Théorie, car en Théorie tout se passe bien.

  5. #5
    Membre habitué
    Bonjour halaster08,

    Je te rassure, je ne pense pas non plus que les adresses courriels fonctionnent avec des caractères particuliers ; ce sont les noms réels qui peuvent avoir des apostrophes que les informaticiens transforment souvent en underscore...

    les supprimer ne résout donc pas mon problème, mais les cas sont peu nombreux, ils seront traités à la main suite au rejet du mail ; c'est pas très propre... mais cela fait 2 jours que je suis là dessus.

    Je ne comprends pas que ce cas ne soit pas abordé complètement dans les nombreuses demandes de dépannage que j'ai vu.

    Merci pour ton aide, bonne journée.

    Je vais attendre encore qq jr pour clôturer, si qq'1 a une solution globale...

  6. #6
    Membre actif
    Salut,
    pour qu'on y voit un peu plus clair il faudrait que tu nous donnes des exemples de ce que tu as en entrée et de ce que tu attends en sortie. A mon avis on peut tout faire en expression régulière mais tant qu'il n'y a pas d'exemples, cela relève de la boule de cristal
    Nullosse

  7. #7
    Membre habitué
    Bonjour Nullosse,
    Nos messages se sont croisés...
    Les exemples sont courants, il s'agit d'une liste d'utilisateurs de ma boîte que je cherche à contacter, donc j'ai une base de données de noms / prénoms saisis par des personnes différentes, avec ou sans accent, avec des caractères particuliers...

    comme par exemple :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    HAÏB Nadjima		nadjima.haib@entreprise.fr
    RANÀ DE NOM Georges	georges.rana-de-nom@entreprise.fr
    RENÉ-MERE marie		marie.rene-mere@entreprise.fr
    REÑÉ Carine		carine.rene@entreprise.fr
    FRANÇOIS Paul		paul.francois@entreprise.fr
    TRANÎER Derière		deriere.tranier@entreprise.fr
    PORTE D IMMEUBLE Jean	jean.porte-d-immeuble@entreprise.fr
    PORTE D IMMEUBLE Jean	jean.porte-d-immeuble@entreprise.fr
    PORTE D_IMMEUBLE Jean	jean.porte-d-immeuble@entreprise.fr
    PORTE D'IMMEUBLE Jean	jean.porte-d-immeuble@entreprise.fr

  8. #8
    Membre actif
    Dans un premier temps voilà une fonction vite fait sur le gaz qui marche pour les exemples sans nom et prénom composés. Ensuite pour les noms et prénoms composés , ça demande plus de réflexion.
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Function AdresseCourriel(ATrouver As String) As String
    'KO : _ '
    AdresseCourriel = "Pas générée"
    Dim accent As String, sansAccent As String, i As Long
    accent = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    sansAccent = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    For i = 1 To Len(accent)
        ATrouver = Replace(ATrouver, Mid(accent, i, 1), Mid(sansAccent, i, 1))
    Next i
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "([A-Z]{2,}-*) ([A-Z]{1}[a-z]+)"
            If .Test(ATrouver) Then
        Nom = .Execute(ATrouver)(0).SubMatches(0)
        Prenom = .Execute(ATrouver)(0).SubMatches(1)
        AdresseCourriel = LCase(Prenom) + "." + LCase(Nom) + "@entreprise.fr"
        End If
    End With

  9. #9
    Membre habitué
    Bonjour,

    J'ai trouvé, sur le site qq'1 qui a traité une partie du sujet (ouskel'n'or) et qui semble résoudre tous les cas ; il a eu la bonne idée de partir à l'envers pour savoir si la chaine fait partie du NOM ou du Prénom, c'est à dire qu'il examine la dernière lettre du mot si elle est majuscule ou minuscule...
    Par contre, je n'ai pas tout compris ;

    j'aurai préféré une fonction, mais c'est déjà bien

  10. #10
    Membre actif
    Bon j'ai réussi à m'occuper des noms et des prénoms composés.
    Le principe de la fonction :
    1 - On remplace tous les accents
    2 - Dans le Regex on extrait 2 groupes le nom et le prénom . Le nom est caractérisé parce qu'il commence par 2 Majuscules et le prénom parce qu'il commence par une majuscule et une minuscule.
    3 - On remplace à la fin les _ ' et espace par tiret
    Voici la fonction :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    Function AdresseCourriel(ATrouver As String) As String
    'KO : _ '
    AdresseCourriel = "Pas générée"
    Dim accent As String, sansAccent As String, i As Long
    accent = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
    sansAccent = "AAAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    For i = 1 To Len(accent)
        ATrouver = Replace(ATrouver, Mid(accent, i, 1), Mid(sansAccent, i, 1))
    Next i
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "([A-Z]{2}[A-Z \-_']+) ([A-Z]{1}[a-z]{1,}[a-zA-Z \-_']+)"
        If .Test(ATrouver) Then
          Nom = .Execute(ATrouver)(0).SubMatches(0)
          Prenom = .Execute(ATrouver)(0).SubMatches(1)
          AdresseCourriel = LCase(Prenom) + "." + LCase(Nom) + "@entreprise.fr"
          aRemplacer = " _'"
          For i = 1 To Len(aRemplacer)
            AdresseCourriel = Replace(AdresseCourriel, Mid(aRemplacer, i, 1), "-")
          Next i
        End If
    End With
    End Function


    et le résultat avec tes exemples :



    Il y avait un piège : le À n'était pas dans le code initial de remplacement des accents.

    Nullosse le plus nul des programmeurs

  11. #11
    Membre habitué
    Bonsoir, Pas si Nullosse que ça !

    Désolée pour le jeu de mot nul ;>)
    Un grand bravo, merci beaucoup, ça faisait longtemps que je cherchais une telle fonction, mais là j'en ai vraiment besoin

    Merci beaucoup pour ce boulot