Discussion :

[mouftie]

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

[halaster08]

Bonjour,

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 ?

[mouftie]

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

[halaster08]

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.

[mouftie]

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

[Nullosse]

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

[mouftie]

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

[Nullosse]

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

[mouftie]

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

[Nullosse]

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

[mouftie]

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