construite sur une base de 2322 prénoms.
Code : Tout sélectionner
REM  *****  BASIC  *****
'========================================
'Auteur : Martinbrait
'EXTRAIRE LE NOM EN FONCTION D'UN PRENOM,
'DANS UNE CHAINE DE CARACTERES
'On commence par identifier le prénom d'une chaine de caractères,
'via la fonction RECUPPRENOM()
'On en déduit le nom, comme la partie restante de la chaine de caractères,
'ayant fait l'objet d'une extraction.
'Pour les cas des atomes de doubles prénoms sans autre précision,
'l'application positionne le prénom à gauche, sauf cas contraire,
'précisé par l'utilisateur, par l'ajout du paramètre 2
' RecupPrenom("Jacques Martin") -> Jacques
' RecupPrenom("Jacques Martin";2) -> Martin
'=======================================
'auteur : martinbrait
Function RecupPrenoms(arg As Variant,Optional PosPrenom As Integer) As String
'Dim varg As Variant
Dim NewPos As Integer
Dim i As Integer
Dim vPrenoms As Variant
Dim iMiniBound As Integer
Dim iMaxiBound As Integer
Dim sTemp As String
Dim sPrenoms As String
'Msgbox "test1" & TypeName(arg)
If IsMissing (PosPrenom) Then
PosPrenom = 1
End If
If Len(arg)>0 Then
	'amélioration du prénom arrivant :
	arg = Trim(arg)
	If Left(arg,1)="-" Then
	arg = Right(arg,Len(arg)-1)
	End If
	arg = Trim(arg)
	
	If PosPrenom = 1 Then
	NewPos = Instr(1,arg," ")
	arg = Left(arg,NewPos)
	
	ElseIF PosPrenom = 2 Then
	NewPos = Instr(1,arg," ")
	arg = Right(arg,Len(arg)-NewPos)
	RecupPrenoms = arg
	End If
	
	
	If Instr(1,arg,"-")>0 Then
	arg = split(arg,"-")
	ElseIf Instr(1,arg," ")>0 Then
	arg = split(arg," ")
	End If	
	
	
Else
	sPrenoms = ""
End If
	
' on retraite tout le monde à condition qu'ils soient des variant
If TypeName(arg)="Variant()" Then
'Msgbox "test3" & TypeName(arg)
	
	If  UBound(arg)>0  Then
		iMiniBound = LBound(arg)
		iMaxiBound = UBound(arg)
		
		'MsgBox iMiniBound
		'MsgBox iMaxiBound
		
		'vidage
		sPrenoms = ""			
		
		For i = iMiniBound To iMaxiBound
			sTemp = UCase(arg(i))
			
			If iMaxiBound > iMiniBound Then
				If Len(sTemp)>0 Then
					If Len(sPrenoms)= 0 Then
					sPrenoms= Left(sTemp,1) & LCase(Right(sTemp,Len(sTemp)-1))
					Else
					sPrenoms= sPrenoms & "-" & Left(sTemp,1) & LCase(Right(sTemp,Len(sTemp)-1))
					End If
				End If
			EndIf
			
			'on récupère le prénom, en l'état, en fin de boucle
			If i = iMaxiBound Then
					RecupPrenoms = sPrenoms
			End If
		Next
		
	Else
	RecupPrenoms = ""
	End If
	
End If	
End Function
Sub TestPrenom()
atometest = "Alexandre Honoré Ernest COQUELIN"
Msgbox  TrameDuPatronyme(atometest)
MsgBox RecupPrenom(atometest)
atometest = "André Antoine"
Msgbox  TrameDuPatronyme(atometest)
MsgBox RecupPrenom(atometest)
End Sub
Function RecupPrenom(atome As String,Optional PositPrenom As Integer)
Dim PosSpace As Integer
Dim strTemp As String
'nettoyage de l'atome entrant
atome = Trim(atome)
If Left(atome,1)="-" Then
atome = Right(atome,Len(atome)-1)
End IF
atome = Trim(atome)
'Pour les prénoms-noms indifférenciés, on présuppose une position du prénom par défaut = 1 (sauf cas contraire)
If IsMissing(PositPrenom) Then
PositPrenom = 1
End If
If PositPrenom > 2 Then
'pas de position de prénom supérieure à 2,
'on rentourne à une position par défaut 1 du prénom
PositPrenom = 1
End If
If Instr(1,atome,"-")>0 Then
atome = Replace(atome,"-"," ")
End If
If Instr(1,atome," ")>0 Then
Select Case TrameDuPatronyme(atome)
	Case "10"
		strTemp = Left(atome,Instr(1,atome," "))
	Case "11"
		'ne sachant différencier le prénom du nom de famille,
		'on va se fier au positionnement prénom suivi du nom de famille, par défaut.
		'sauf cas contraire spécifié dans l'option de positionnement.
		If PositPrenom = 1 Then
		strTemp = Left(atome,Instr(1,atome," "))
		ElseIf PositPrenom = 2 Then
		PosSpace = Instr(1,atome," ")
		strTemp = Right(atome,Len(atome)-PosSpace)		
		End IF
			
	Case "100"
		strTemp = Left(atome,Instr(1,atome," "))
	Case "110"
		PosSpace = Instr(1,atome," ")
		strTemp = Left(atome,Instr(PosSpace+1,atome," ")
	Case "111"
		strTemp = ""
	Case "0"
		strTemp = ""			
	Case "00"
		strTemp = ""		
	Case "01"
		PosSpace = Instr(1,atome," ")
		strTemp = Right(atome,Len(atome)-PosSpace)		
	Case "000"
		strTemp = ""
	Case "010"
		strTemp = ""
	Case "011"
		PosSpace = Instr(1,atome," ")
		strTemp = Right(atome,Len(atome)-PosSpace)
		strTemp = Replace(strTemp," ","-")
	Case "1100"		
		PosSpace = Instr(1,atome," ")
		strTemp = Left(atome,Instr(PosSpace+1,atome," ")	
	Case "1110"		
		PosSpace = Instr(1,atome," ")
		PosSpace = Instr(PosSpace+1,atome," ")
		strTemp = Left(atome,Instr(PosSpace+1,atome," ")				
	Case Else
		strTemp = ""
End Select
If Len(strTemp)>0 Then
RecupPrenom = Trim(MiseEnMajuscule5(strTemp))
Else
RecupPrenom = "" 'comble les atomes aux doubles prénoms SAP
End If
Else
'pas d'espacement, position du prénom impossible à identifier
RecupPrenom =""
End If
End Function
Function TrameDuPatronyme(atome As String)
Dim vAtome As Variant
Dim i As Integer
Dim strTemp As String
If Instr(1,atome,"-")>0 Then
atome = Replace(atome,"-"," ")
End If
strTemp ="" 'initialisation
If Instr(Atome," ")>0 Then
vAtome = split(atome," ")
For i = LBound(vAtome) To UBound(vAtome)
	If EstUnPrenom(vAtome(i))>0 Then
		If  Len(vAtome(i))>2 Then
			strTemp = strTemp & 1
		End If
	Else
	strTemp = strTemp & 0
	End If 
Next
End If
TrameDuPatronyme = strTemp
End Function
Function EstUnPrenom(ByRef lePatronyme As String)
Dim strTemp As String
strTemp=Left(UCase(lePatronyme),1)
Select Case strTemp
    Case "A"
    EstUnPrenom=EstUnPrenomA(lePatronyme )
    Case "B"
    EstUnPrenom=EstUnPrenomB(lePatronyme )
    Case "C"
    EstUnPrenom=EstUnPrenomC(lePatronyme )
    Case "D"
    EstUnPrenom=EstUnPrenomD(lePatronyme )
    Case "E"
    EstUnPrenom=EstUnPrenomE(lePatronyme )
    Case "F"
    EstUnPrenom=EstUnPrenomF(lePatronyme )
    Case "G"
    EstUnPrenom=EstUnPrenomG(lePatronyme )
    Case "H"
    EstUnPrenom=EstUnPrenomH(lePatronyme )
    Case "I"
    EstUnPrenom=EstUnPrenomI(lePatronyme )
    Case "J"
    EstUnPrenom=EstUnPrenomJ(lePatronyme )
    Case "K"
    EstUnPrenom=EstUnPrenomK(lePatronyme )
    Case "L"
    EstUnPrenom=EstUnPrenomL(lePatronyme )
    Case "M"
    EstUnPrenom=EstUnPrenomM(lePatronyme )
    Case "N"
    EstUnPrenom=EstUnPrenomN(lePatronyme )
    Case "O"
    EstUnPrenom=EstUnPrenomO(lePatronyme )
    Case "P"
    EstUnPrenom=EstUnPrenomP(lePatronyme )
    Case "Q"
    EstUnPrenom=EstUnPrenomQ(lePatronyme )
    Case "R"
    EstUnPrenom=EstUnPrenomR(lePatronyme )
    Case "S"
    EstUnPrenom=EstUnPrenomS(lePatronyme )
    Case "T"
    EstUnPrenom=EstUnPrenomT(lePatronyme )
    Case "U"
    EstUnPrenom=EstUnPrenomU(lePatronyme )
    Case "V"
    EstUnPrenom=EstUnPrenomV(lePatronyme )
    Case "W"
    EstUnPrenom=EstUnPrenomW(lePatronyme )
    Case "X"
    EstUnPrenom=EstUnPrenomX(lePatronyme )
    Case "Y"
    EstUnPrenom=EstUnPrenomY(lePatronyme )
    Case "Z"
    EstUnPrenom=EstUnPrenomZ(lePatronyme )
End Select
End Function 
Function EstUnPrenomA(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Aaron;Abdallah;Abdel;Abdelkader;Abel;Abigaelle;Abigail;Abishan;Aboubacar;Aboubakar;Abraham;Absolon;Aby;Achille;Achraf;Ada;Adam;Adama;Adame;Adel;Adelaide;Adele;Adelie;Adeline;Adem;Aden;Adib;Adil;Adja;Adnane;Adolphe;Adrian;Adriana;Adriano;Adriel;Adrien;Adrienne;Aedan;Agathe;Aglae;Agnes;Aharon;Ahmad;Ahmed;Aicha;Aidan;Aiden;Aime;Aimee;Aissatou;Akram;Aksel;Aksil;Alaa;Alain;Alais;Alan;Alana;Alassane;Alba;Alban;Albane;Albert;Albertine;Albin;Aldo;Alec;Aleksandar;Aleksandra;Alessandro;Alessia;Alessio;Alex;Alexander;Alexandra;Alexandre;Alexandrie;Alexane;Alexi;Alexia;Alexis;Alexy;Alfred;Alhassane;Ali;Alia;Alice;Alicia;Alienor;Alima;Alina;Aline;Aliou;Alisha;Alison;Alissa;Alistair;Alix;Alixe;Aliya;Aliyah;Alizee;Allan;Allegra;Allya;Alma;Alois;Alon;Alone;Aloys;Alpha;Alphonse;Alphonsine;Alwena;Aly;Alya;Alyah;Alycia;Alyssa;Alyssia;Alysson;Amadou;Amael;Amaia;Amalia;Amanda;Amandine;Amani;Amar;Amara;Amarante;Amaury;Amaya;Ambre;Ambrine;Ambroise;Amedee;Amel;Amelia;Amelie;Amicie;Amin;Amina;Aminata;Amine;Amir;Amira;Amjad;Amos;Amy;Ana;Anabelle;Anae;Anael;Anaelle;Anais;Anas;Anass;Anastasia;Anastasie;Anatole;Anaya;Andre;Andrea;Andreas;Andree;Andrei;Andrew;Andy;Anes;Ange;Angel;Angela;Angele;Angelina;Anouk;Angeline;Angelique;Angelo;Angie;Ania;Anis;Anissa;Anita;Anna;Annabelle;Annaelle;Anne;Anne-Laure;Anne-Sophie;Annette;Annie;Anny;Anouck;Anouk;Anselme;Anthony;Antoine;Antoinette;Anton;Antoni;Antonia;Antonin;Antonio;Antony;Anya;Apollinaire;Apolline;Appoline;Archibald;Arda;Ari;Aria;Ariana;Ariane;Arianne;Arie;Ariel;Arielle;Arienne;Arij;Aris;Aristide;Arlette;Arman;Armance;Armand;Armel;Armelle;Arnaud;Arnaude;Arno;Aron;Arsene;Arslane;Artemis;Arthur;Arthus;Arto;Artus;Arwa;Arwen;Arya;Ashley;Asia;Asma;Asmaa;Assa;Assetou;Assia;Assil;Assiya;Assya;Astou;Astrid;Athena;Aubane;Aubin;Aude;Audrey;Auguste;Augustin;Augustine;Aure;Aurel;Aurele;Aurelia;Aurelie;Aurelien;Auriane;Aurore;Auxence;Ava;Avi;Aviel;Avital;Avril;Awa;Axel;Axelle;Aya;Ayaan;Ayah;Ayana;Aydan;Ayden;Ayem;Ayla;Aylan;Aylin;Ayline;Ayman;Aymane;Aymen;Aymeric;Ayoub;Aysha;Azad;Aziliz;Aziz"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomA=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomB(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Babacar;Badis;Bafode;Bahia;Bakary;Balkis;Balthazar;Baptiste;Barbara;Barnabe;Barthelemy;Basil;Basile;Basma;Bastian;Bastien;Batiste;Baudouin;Baya;Beatrice;Bella;Ben;Benedicte;Benjamin;Benjamine;Benoit;Benoite;Berenice;Bernadette;Bernard;Berthe;Bertille;Bertrand;Beryl;Bettina;Betty;Beya;Bianca;Bilal;Bilel;Billie;Binta;Bintou;Blaise;Blanche;Blandine;Blessing;Bleuenn;Bogdan;Bonnie;Boris;Bosco;Boubacar;Boubou;Bouchra;Bradley;Brahim;Brandon;Brayan;Briac;Brian;Brice;Brieuc;Brigitte;Brune;Bruno;Bryan"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomB=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomC(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Calie;Calista;Calixte;Calvin;Camelia;Cameron;Camil;Camila;Camilia;Camille;Camilo;Candice;Capucine;Carine;Carl;Carla;Carlotta;Carmen;Carole;Carolina;Caroline;Cassandra;Cassandre;Cassie;Cassiopee;Castille;Catherine;Cecile;Cecilia;Cedric;Celeste;Celestin;Celestine;Celia;Celian;Celina;Celine;Cerise;Cesaire;Cesar;Chaden;Chahine;Chahinez;Chaima;Chanel;Chantal;Chante;Charles;Charlie;Charline;Charlize;Charlot;Charlotte;Charly;Chayma;Cheick;Cheick-Oumar;Cheikh;Chelsea;Chiara;Chirine;Chloe;Chmouel;Chris;Christ;Christelle;Christian;Christina;Christine;Christophe;Christopher;Ciara;Cindy;Claire;Clara;Clarence;Clarisse;Claude;Claudette;Claudia;Claudine;Clea;Clelia;Clelie;Clemence;Clement;Clementine;Cleo;Cleophee;Cloe;Clothilde;Clotilde;Clovis;Colette;Colin;Coline;Colombain;Colomban;Colombe;Come;Constance;Constant;Constantin;Coralie;Coraline;Corentin;Corin;Corinne;Corto;Cosette;Cosima;Coumba;Cristiano;Cunegonde;Curtis;Cynthia;Cyprien;Cyrian;Cyriaque;Cyrielle;Cyril;Cyrille;Cyrine;Cyrus"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomC=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomD(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Dahlia;Dali;Dalia;Dalla;Dalya;Damian;Damien;Dan;Dana;Danae;Dani;Dania;Daniel;Daniela;Daniele;Daniella;Danielle;Danny;Dany;Danyl;Daoud;Daouda;Daphne;Daphnee;Daria;Darine;Dario;Darius;Darren;Darry;David;Dayan;Dayane;Deborah;Delia;Delphine;Demba;Denis;Denise;Desire;Desiree;Deva;Diana;Diane;Dianne;Didier;Diego;Dieudonne;Dieudonnee;Dieynaba;Dilan;Dimitri;Dina;Diodore;Dion;Divine;Djena;Djeneba;Djenna;Djibril;Dominique;Domitille;Donat;Donatien;Donatienne;Dora;Dorian;Doriane;Dorothee;Dounia;Dov;Driss;Dune;Dylan;Dyna"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomD=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomE(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Eddy;Eden;Edgar;Edgard;Edith;Edmond;Edouard;Eduard;Eduardo;Edward;Edwige;Edwin;Eglantine;Eileen;El;Ela;Elaia;Elea;Eleanor;Eleanore;Elena;Eleonore;Elhadj;Eli;Elia;Eliahou;Elian;Eliana;Eliane;Elias;Elie;Eliel;Eliette;Elif;Elijah;Elina;Eline;Elinor;Elio;Elior;Eliora;Eliot;Eliott;Elisa;Elisabeth;Elise;Elissa;Eliza;Elizabeth;Ella;Ellie;Elliot;Elliott;Elly;Eloan;Eloane;Elodie;Eloi;Eloise;Elon;Elona;Elone;Elora;Elouan;Elouann;Elsa;Elvire;Ely;Elya;Elyan;Elyana;Elyas;Elyes;Elyne;Elyssa;Ema;Emeline;Emi;Emie;Emil;Emile;Emilia;Emilie;Emilien;Emilio;Emily;Emir;Emma;Emmanuel;Emmanuella;Emmanuelle;Emmie;Emmy;Emna;Emy;Eneko;Enguerrand;Ennio;Enola;Enora;Enzo;Eric;Erik;Erika;Erin;Erine;Ermenegilde;Ernest;Ernestine;Erwan;Erwann;Esmee;Esteban;Estelle;Esther;Ethan;Ethann;Ethel;Etienne;Eugene;Eugenie;Eulalie;Eunice;Eurydice;Eustache;Eva;Evan;Evann;Evans;Evariste;Eve;Evette;Evrard;Evy;Ewan;Ewen;Ewenn;Eya;Eyal;Eytan;Eythan;Ezio;Ezra"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomE=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomF(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Fabien;Fabienne;Fabio;Fabrice;Fadi;Fady;Fahd;Faith;Fallou;Fanny;Fanta;Fantine;Farah;Fares;Farouk;Fatim;Fatima;Fatimata;Fatima-Zahra;Fatma;Fatou;Fatouma;Fatoumata;Faustine;Faycal;Federico;Felicie;Felicien;Felicienne;Felicite;Felix;Ferdinand;Feriel;Fernand;Fernande;Feryel;Fiacre;Fifi;Filip;Filipe;Fiona;Firas;Firdaws;Firmin;Flavia;Flavie;Flavien;Flavio;Fleur;Flora;Flore;Florence;Florent;Florentin;Florette;Florian;Floriane;Florianne;Fode;Foucauld;Frana§Ois;Francesca;Francesco;Francine;Francis;Franck;Francois;Francoise;Franklin;Frederic;Frederique;Frida"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomF=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomG(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Gabin;Gabriel;Gabriela;Gabriele;Gabriella;Gabrielle;Gaby;Gad;Gael;Gaelle;Gaetan;Gaetane;Gaia;Garance;Gary;Gaspar;Gaspard;Gaston;Gauthier;Gautier;Genevieve;Geoffrey;Geoffroi;Geoffroy;George;Georges;Georgette;Georgia;Georgine;Gerald;Gerard;Geraud;Germain;Germaine;Gervais;Gervaise;Ghislain;Ghislaine;Giacomo;Gianni;Gigi;Gilberte;Gilles;Gina;Ginette;Giovanni;Gisele;Giselle;Gisselle;Giulia;Giulian;Giulio;Gloria;Godelieve;Gonzague;Goundo;Gra¢Ce;Grace;Gratien;Graƒa¢Ce;Gregoire;Gregory;Greta;Guilhem;Guillaume;Guillemette;Gustave;Guy;Gwenaelle;Gwendal;Gwendoline"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomG=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomH(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Habib;Habiba;Haby;Hadja;Hadriel;Hadrien;Hafsa;Hajar;Hakim;Halima;Hamed;Hamidou;Hamza;Hana;Hanae;Hania;Hanna;Hannah;Haris;Harold;Haron;Haroun;Harouna;Haroune;Harry;Hasna;Hassan;Hassane;Hatem;Hatouma;Hawa;Haya;Hayden;Hector;Hedi;Helena;Helene;Helia;Helie;Helios;Hella;Heloise;Henri;Henriette;Henry;Hercule;Hermance;Hermine;Herve;Hiba;Hicham;Hichem;Hidaya;Hilaire;Hillel;Hind;Hippolyte;Hocine;Honore;Honorine;Hortense;Houda;Hubert;Hugo;Hugues;Hyacinthe"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomH=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomI(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Ian;Iban;Ibrahim;Ibrahima;Ida;Idan;Idir;Idris;Idriss;Idrissa;Ignace;Igor;Ikram;Ilan;Ilana;Ilann;Ilham;Ilhan;Ilian;Iliana;Iliane;Ilias;Ilies;Ilina;Ilona;Ilyan;Ilyana;Ilyane;Ilyas;Ilyass;Ilyes;Ilyess;Imad;Iman;Imane;Imanol;Imany;Imen;Imene;Imran;Imrane;Inaya;Inayah;India;Ines;Inna;Inza;Irene;Irenee;Irina;Iris;Isaac;Isabella;Isabelle;Isadora;Isaiah;Isaure;Isee;Iseult;Ishak;Ishaq;Isidore;Isis;Islam;Islem;Ismael;Ismail;Isra;Israa;Issa;Issam;Issiaka;Ivan;Ivy;Iwan;Iyad;Iyed;Izia"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomI=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomJ(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Jacinthe;Jack;Jacob;Jacqueline;Jacques;Jad;Jade;Jaden;Jalil;Jamal;Jamel;James;Jan;Jana;Jane;Janelle;Janie;Janna;Jannah;Jarod;Jasmine;Jason;Jassem;Jassim;Jawad;Jawed;Jayan;Jayden;Jayson;Jean;Jean-Baptiste;Jeanine;Jean-Marc;Jean-Marie;Jeanne;Jeannette;Jeannine;Jeannot;Jean-Pierre;Jed;Jehanne;Jenna;Jennah;Jennifer;Jenny;Jeremie;Jeremy;Jerome;Jessica;Jessie;Jessim;Jessy;Jibril;Jihane;Jill;Jim;Jimmy;Jinane;Joachim;Joakim;Joan;Joana;Joanna;Joanne;Joaquim;Joceline;Jodie;Joe;Joel;Joelle;Joey;Johan;Johana;Johann;Johanna;Johanne;John;Johnny;Jolie;Jonah;Jonas;Jonathan;Jordan;Joris;Josee;Joseph;Josephe;Josephine;Josette;Josh;Joshua;Josiane;Josue;Joud;Jourdain;Joy;Joyce;Juan;Juba;Jude;Judith;Jules;Julia;Julian;Juliana;Juliane;Juliann;Julianne;Julie;Julien;Julienne;Juliette;Jun;June;Junior;Junon;Juste;Justin;Justine"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomJ=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomK(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Kacper;Kader;Kadiatou;Kadidia;Kadidiatou;Kadidja;Kady;Kahil;Kahina;Kais;Kamel;Kamelia;Kamil;Kamila;Karamba;Karamoko;Karen;Karim;Karine;Karl;Karla;Karolina;Kassim;Kate;Katell;Kathleen;Katia;Kawtar;Kawthar;Kayla;Kayliah;Kayna;Kays;Keira;Kelia;Kelian;Kelly;Kelvin;Kelya;Kelyan;Kenan;Kendra;Kendrick;Kenny;Kentin;Kenza;Kenzi;Kenzo;Kenzy;Keren;Ketsia;Kevin;Keyla;Keziah;Khadidiatou;Khadidja;Khadija;Khady;Khaled;Khalifa;Khalil;Kheira;Kiara;Kilian;Killian;Kilyan;Kim;Kimberly;Kimi;Kimia;Kiyan;Klara;Klervi;Koumba;Kristina;Kurtis;Kyan;Kyle;Kylian;Kyliann;Kyllian"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomK=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomL(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Ladji;Laetitia;Lahna;Lalie;Laly;Lalya;Lamia;Lamine;Lana;Lancelot;Lara;Lassana;Laszlo;Latifa;Laura;Laure;Lauren;Laurence;Laurent;Laurentine;Laurette;Lauriane;Laurie;Laurine;Lauryn;Lauryne;Laya;Layana;Layanah;Layane;Layla;Layna;Lazar;Lazare;Lea;Leana;Leandre;Leandro;Leane;Leanne;Leelou;Lehna;Leia;Leila;Lena;Leni;Lenny;Leny;Leo;Leon;Leonard;Leonardo;Leonce;Leonie;Leonne;Leonor;Leonore;Leontine;Leo-Paul;Leopold;Leopoldine;Leslie;Leticia;Levana;Levi;Lewis;Leya;Leyla;Leyna;Lia;Liam;Liana;Liane;Liel;Liham;Lila;Lilas;Lili;Lilia;Lilian;Liliana;Liliane;Lilie;Lili-Rose;Lilly;Lilou;Lilwenn;Lily;Lilya;Lily-Rose;Lina;Linda;Lindsay;Line;Lino;Linoy;Lionel;Lior;Liora;Lirone;Lisa;Lisandro;Lise;Lisette;Lison;Lital;Liv;Livia;Livio;Liya;Liyah;Liz;Liza;Lizea;Loan;Loane;Loann;Logan;Lohan;Loic;Loick;Lois;Lola;Lorena;Lorenzo;Loris;Lorraine;Lothaire;Lou;Louan;Louane;Louann;Lou-Ann;Louanne;Lou-Anne;Louay;Loubna;Louca;Louis;Louisa;Louise;Louis-Marie;Louison;Louka;Loula;Louna;Lounis;Loup;Luan;Lubin;Luc;Luca;Lucas;Luce;Lucia;Lucie;Lucien;Lucienne;Lucile;Lucille;Lucinde;Lucrece;Lucy;Ludivine;Ludmila;Ludovic;Luigi;Luis;Luisa;Luka;Lukas;Luke;Lula;Luna;Lunete;Luz;Lya;Lyah;Lyam;Lyana;Lydia;Lydie;Lyes;Lyham;Lyla;Lylia;Lylou;Lyna;Lyne;Lynn;Lysandre;Lyse"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomL=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomM(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Maayane;Maceo;Madeleine;Madeline;Madina;Mado;Mady;Mae;Mael;Maelia;Maelie;Maelis;Maelle;Maelya;Maelys;Maeva;Magdalena;Mahamadou;Mahault;Mahaut;Mahdi;Mahe;Maher;Mahmoud;Mai;Maia;Mailys;Maimouna;Maina;Maissa;Maissane;Maiwenn;Maja;Makan;Maksim;Malak;Malcolm;Malek;Malia;Malick;Malik;Malika;Malo;Malone;Malorie;Mamadou;Mame;Mamou;Mamoudou;Manal;Manar;Manel;Manelle;Manil;Manon;Manuel;Manuela;Mara;Maram;Marc;Marc-Antoine;Marceau;Marcel;Marceline;Marcelle;Marcellette;Marcellin;Marcelline;Marcello;Marco;Marcus;Margaux;Margo;Margot;Marguerite;Maria;Mariam;Mariama;Mariame;Marianne;Marie;Marie-Ange;Marie-Georges;Marielle;Marie-Lou;Mariem;Mariette;Marilou;Marin;Marina;Marine;Mario;Marion;Marise;Marius;Marjane;Marjorie;Mark;Marko;Marlene;Marley;Marlon;Marnie;Marouane;Marta;Martha;Marthe;Martin;Martine;Marvin;Marwa;Marwan;Marwane;Marwen;Maryam;Marylou;Massil;Massinissa;Massyl;Mateja;Mateo;Mateusz;Matheo;Mathias;Mathieu;Mathilda;Mathilde;Mathis;Mathurin;Mathys;Matias;Matilda;Matilde;Matis;Matisse;Matt;Matteo;Mattheo;Matthew;Matthias;Matthieu;Matthis;Mattia;Mattis;Matys;Maud;Maude;Maureen;Maurice;Max;Maxance;Maxence;Maxens;Maxim;Maxime;Maximilian;Maximilien;Maximilienne;Maxine;May;Maya;Mayane;Mayar;Mayas;Mayeul;Mayline;Maylis;Mayssa;Mayssane;Mehdi;Mehmet;Meir;Melanie;Melchior;Melia;Melina;Melinda;Meline;Melissa;Mellina;Melodie;Melody;Melusine;Melvil;Melvin;Melvyn;Menahem;Mendel;Meriam;Meriem;Merlin;Merwan;Meryam;Meryem;Meryl;Meyron;Mia;Michael;Michel;Michele;Micheline;Michelle;Mickael;Mignon;Miguel;Mika;Mikail;Mike;Mila;Milan;Milena;Milhan;Milica;Milla;Milo;Mina;Minh;Mira;Mirabelle;Mireille;Miya;Moche;Modeste;Modestine;Modibo;Mody;Mohamed;Mohamed-Ali;Mohamed-Amine;Mohamed-Lamine;Mohammad;Mohammed;Mona;Monica;Monique;Morgaine;Morgan;Morgane;Mory;Mouad;Mouctar;Mouhamadou;Mouhamed;Mouhammad;Moulay;Mounir;Moussa;Moustafa;Moustapha;Muhammad;Muhammed;Mustafa;Mustapha;Mya;Myla;Mylan;Myriam;Myrtille"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomM=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomN(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Nabil;Nada;Nadia;Nadine;Nadir;Nael;Naelle;Nahel;Nahia;Nahil;Nahla;Nahyl;Naila;Naim;Nais;Nala;Namizata;Namory;Nana;Naomi;Naomie;Naor;Narcisse;Nassim;Natacha;Natalia;Natalie;Natan;Natasha;Nathael;Nathalie;Nathan;Nathanael;Nathaniel;Nawal;Nawel;Nawfel;Naya;Nayel;Nayla;Nazaire;Nazim;Neela;Neil;Neila;Nelia;Nell;Nelly;Nelson;Nelya;Nene;Neo;Nermine;Nesrine;Neyla;Niame;Nicodeme;Nicolas;Nicole;Nicolette;Niels;Nikita;Nikola;Nil;Nils;Nina;Nine;Ninette;Nino;Ninon;Niouma;Nisa;Nizar;Noa;Noah;Noam;Noan;Noe;Noel;Noelie;Noella;Noelle;Noemi;Noemie;Noha;Noham;Nohan;Nola;Nolan;Nolann;Nolhan;Nolwenn;Noor;Nora;Norah;Norhane;Nouha;Nour;Noura;Nourane"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomN=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomO(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Oceane;Octave;Odelia;Odette;Odile;Olga;Olive;Oliver;Olivia;Olivie;Olivier;Oliwia;Olympe;Olympia;Omar;Ombeline;Ondine;Onesime;Oona;Ophelie;Ora;Orane;Oren;Oriane;Orianne;Orlane;Ornella;Orso;Ortal;Oscar;Oskar;Othmane;Otto;Ouida;Oumar;Oumou;Ousmane;Oussama;Ovadia;Owen"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomO=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomP(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Pablo;Paco;Paloma;Paola;Paolo;Pape;Papillion;Paris;Pascal;Pascale;Pascaline;Paschal;Patrice;Patricia;Patrick;Paul;Paula;Paul-Antoine;Paul-Arthur;Paule;Paulette;Paulin;Pauline;Pedro;Penda;Penelope;Perceval;Perrette;Perla;Perle;Perrine;Peter;Petronille;Pharell;Phileas;Philemon;Philibert;Philippa;Philippe;Philippine;Pia;Pierre;Pierre-Alexandre;Pierre-Antoine;Pierre-Louis;Pierrette;Pietro;Placide;Pol;Pons;Prenoms;Preston;Prince;Prisca;Priscille;Prn;Prosper;Prudence;Prune"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomP=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomQ(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Qassim;Quentin;Quitterie"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomQ=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomR(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Racha;Rachel;Rafael;Rafaela;Rahim;Rahma;Rainier;Ramata;Rami;Ramy;Ramzy;Rana;Rania;Ranim;Ranya;Raoul;Raphael;Raphaelle;Rawane;Rayan;Rayane;Rayen;Rayhana;Raymonde;Razane;Rebecca;Reda;Regine;Regis;Reine;Remi;Remy;Renard;Renaud;Rene;Renee;Reynaud;Riad;Ricardo;Richard;Rim;Rita;Ritaj;Ritej;Rivka;Riyad;Robert;Robin;Robinson;Roch;Rochelle;Rodolphe;Rodrigo;Rodrigue;Rohan;Rokia;Rokya;Rolande;Romain;Romaine;Roman;Romane;Romeo;Romie;Romy;Ron;Ronan;Rosa;Rosalie;Rose;Roselle;Rosemonde;Rosette;Rosine;Roxane;Roxanne;Roy;Ruben;Ruby;Rudy;Ruth;Ryad;Ryan;Rym"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomR=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomS(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Saad;Sabine;Sabri;Sabrina;Sabrine;Sacha;Sadio;Safa;Safia;Safiatou;Safiya;Safya;Sahel;Said;Saif;Saja;Sakina;Salem;Salif;Salim;Salima;Salimata;Sally;Salma;Salman;Salome;Salomon;Sam;Samantha;Samba;Sami;Samia;Samir;Samira;Samson;Samuel;Samy;Sana;Sanaa;Sandra;Sandrine;Sandro;Santiago;Sara;Sarah;Sarra;Sasha;Saskia;Satine;Saturnin;Saul;Savannah;Scarlett;Scott;Sean;Sebastian;Sebastien;Sebastienne;Sekou;Selena;Selene;Selim;Selma;Selyan;Sephora;Seraphine;Serena;Serge;Serine;Severin;Severine;Seydina;Seydou;Seynabou;Shaina;Shana;Shani;Shanice;Shanna;Shannon;Shanon;Shany;Sharon;Shawn;Shay;Shayan;Shayma;Shayna;Shelly;Sherine;Shirel;Shirine;Shyrel;Sia;Sibylle;Sidi;Sidney;Sidonie;Sidy;Sienna;Siham;Sihem;Silas;Siloe;Simeon;Simon;Simone;Sinan;Sira;Sirine;Sixte;Sixtine;Skander;Soan;Sofia;Sofian;Sofiane;Sofya;Sohan;Sohane;Sokhna;Solal;Solange;Solene;Solenn;Soline;Solveig;Sonia;Sophia;Sophie;Soraya;Soren;Soukaina;Soulayman;Souleyman;Souleymane;Soumaya;Stacy;Stan;Stanislas;Stanley;Steeve;Stefan;Stella;Stephane;Stephanie;Steve;Steven;Suzanne;Suzette;Suzie;Suzy;Sven;Swan;Swann;Sybille;Sydney;Sylia;Sylvain;Sylvaine;Sylvestre;Sylvia;Sylviane;Sylvianne;Sylvie;Syrine"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomS=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomT(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Taha;Tahar;Tahel;Tal;Tali;Talia;Talya;Tamara;Tanguy;Tania;Tanya;Tao;Tara;Tasnim;Tasnime;Tatiana;Tatienne;Taym;Tayron;Tea;Teddy;Telesphore;Telma;Teo;Terence;Tesnim;Tesnime;Tess;Tessa;Thais;Thalia;Thanina;Thea;Theirn;Thelma;Theo;Theodore;Theophane;Theophile;Theotime;Therese;Thiago;Thibaud;Thibault;Thibaut;Thierno;Thierry;Thimeo;Thomas;Tia;Tiago;Tiana;Tidiane;Tiffany;Tiguida;Tilio;Tim;Timeo;Timothe;Timothee;Timothy;Tina;Tino;Tiphaine;Titouan;Tobias;Toinette;Tom;Toma;Tomas;Tommy;Tony;Toscane;Toussaint;Tracy;Tristan;Tsipora;Tybalt;Tyler;Tymeo;Tyron"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomT=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomU(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Ugo;Ulysse;Urbain;Ursule"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomU=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomV(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Vadim;Valentin;Valentina;Valentine;Valentino;Valere;Valeria;Valerie;Valery;Vanessa;Vasco;Vera;Vernon;Veronique;Vespasien;Vianney;Victoire;Victor;Victoria;Victorien;Victorine;Vienne;Viktor;Viktoria;Vincent;Violette;Virgil;Virgile;Virginie;Viviane;Vivien;Vivienne;Vladimir"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomV=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomW(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Waast;Wafaa;Walburge;Waldemar;Walder;Waldy;Walfrid;Walfroy;Wallerand;Walter;Walther;Wanda;Wandrille;Wandy;Warren;Waudru;Weltaz;Wenceslas;Wendel;Wendeline;Wendy;Werburge;Werner;Wilbert;Wilbrord;Wilfrid;Wilfried;Wilhelm;Wilhelmine;Willard;Willehad;Willem;William;Willibald;Willibrord;Willy;Wilmart;Wilson;Winebald;Winifred;Winnie;Winnoc;Winoc;Winston;Wisigarde;Wivine;Wladimir;Wolfgang;Wolfram;Wulfran;Wulfstan;Wunibald;Wynnebald"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomW=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomX(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Xant;Xantha;Xanthe;Xanthie;Xanthin;Xavier;Xaviera;Xaviere;Xenia;Xenophon;Xyste;Xytilis;Xytilise"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomX=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomY(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Yacine;Yacoub;Yacouba;Yael;Yahya;Yakine;Yamina;Yan;Yani;Yanis;Yaniss;Yann;Yanni;Yannick;Yannis;Yara;Yaron;Yasin;Yasmina;Yasmine;Yasser;Yassin;Yassine;Yaya;Yazid;Ylan;Yoan;Yoann;Yoav;Yoel;Yohan;Yohann;Yolande;Yona;Yoni;Yosra;Yossef;Youcef;Youenn;Youmna;Youna;Younes;Youness;Younouss;Youri;Yousra;Youssef;Youssouf;Yse;Ysee;Yseult;Yumi;Yuna;Yuri;Yusuf;Yvan;Yves;Yvette;Yvonne"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomY=Instr(1,strTemp,lePatronyme)
End Function
Function EstUnPrenomZ(lePatronyme As String)
Dim strTemp As String
strTemp = "" & _
"Zacharia;Zacharie;Zachary;Zack;Zackary;Zadig;Zahra;Zakaria;Zakariya;Zakary;Zakarya;Zara;Zayd;Zayn;Zaynab;Zayneb;Zeinab;Zelda;Zelie;Zephyr;Zephyrine;Zeynab;Zia;Ziad;Zina;Zineb;Zinedine;Ziyad;Zoe;Zoey;Zohra;Zuzanna;Zyad"
lePatronyme = SupprimerAccents(lePatronyme)
EstUnPrenomZ=Instr(1,strTemp,lePatronyme)
End Function
Function RecupNoms(arg1 as String,arg2 As String)
'amélioration du prénom arrivant :
Dim strNoms As String
Dim vArg1 As Variant
Dim i As Integer
If Len(arg1)>1 Then 'Un prénom a été trouvé...
If Instr(1,arg1," ")>0 Then
'cas du prénom composé
vArg1 = Split(arg1," ")
strNoms = arg2
For i = LBound(vArg1) To UBound(vArg1)
strNoms = Replace(strNoms,vArg1(i),"")
Next
Else
'cas simple, prénom unique
	If Instr(1,arg2,arg1)>0 Then
	strNoms = Replace(arg2,arg1,"")
	End If
	
	strNoms = UCase(strNoms)
	
	If Left(strNoms,1)="-" And Len(strNoms)>0 Then'éviter les exceptions en cas de nom pas trouvé
	StrNoms = Right(strNoms,Len(strNoms)-1)
	End If
End If
If Left(StrNoms,1)="-" And Len(StrNoms) > 0 Then
StrNoms = Replace(StrNoms,"-","")
End If
StrNoms = UCase(StrNoms)
RecupNoms = Trim(strNoms)
Else
RecupNoms = ""'le prénom n'ayant pas été trouvé, on ne donne aucune réponse ici.
End If
End Function
Function SupprimerAccents(ByVal sChaine As String) As String
Dim sTmp As String, i As Long, p As Long
Const sCarAccent As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const sCarSansAccent As String = "AAAAACEEEEIIIINOOOOOUUUUYaaaaaaceeeeiiiinooooouuuuyy"
    sTmp = sChaine
    For i = 1 To Len(sTmp)
        p = InStr(sCarAccent, Mid(sTmp, i, 1))
        If p > 0 Then Mid$(sTmp, i, 1) = Mid$(sCarSansAccent, p, 1)
    Next i
    SupprimerAccents = sTmp
End Function
'Auteur : Dude
Function MiseEnMajuscule5(oTexte As String) As String
   oCalc = CreateUnoService("com.sun.star.sheet.FunctionAccess")
   MiseEnMajuscule5 = oCalc.callFunction("PROPER", array(oTexte))
End Function