Recherche de mot et reperage dans un fichier txt sous excel

**gandolfi** · 05/03/2018, 18h08

Bonjour,

Je dois gerer une liste d'adherents. je dois actualiser cette liste en fonction d'informations piochées dans un fichier pdf.
J'ai transformé ce pdf en txt et j'ai reussi à l'ouvrir sur excel.

Je voudrais maintenant recuperer des infos en me baladant dans ce fichier de 8 ko en faisant une boucle. Il y a la liste des adherents et des infos pas tres bien formatées.

- chercher "M." ou "MME" copier cette valeur dans une variable.
- Sur la meme ligne, recuperer les mots qui suivent "M." ou "MME" et précedent le mot "DPE". Ces mots sont séparés de plusieurs espaces hélas (nom prenom et parfois 2eme prenom)
- recuperer ensuite la ligne avec le caractere ">" s'il existe sinon s'arreter dès que l'on repere les caracteres "-------------"
- Puis recommencer la fonction pour passer aux ligne suivantes

Je ne sais pas si je m'y prend bien en faisant des transformation pdf --> txt --> excel
Je ne sais pas quelles fonctions utilisées

Merci pour votre aide

**Marc-L** · 05/03/2018, 18h12

Bonjour,

utiliser par exemple la recherche d'Excel, voir l'aide VBA interne de Range.Find et son exemple …

Sinon manipuler après avoir activé l'Enregistreur de macro : une base de code est livrée sur un plateau !

___________________________________________________________________________________________________________

Je suis Paris, Egypte, Nigeria, New-York, Mogadicio, Barcelone, London, Manchester, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**gandolfi** · 05/03/2018, 19h21

je n'ai jamais utilisé l'enregistreur de macro.

Le problème c'est qu'une seule colonne est utilisée. Et sur chaque ligne il y a des phrases et non pas une seule valeur par cellule.

MME Dupont ALICE NOELLE DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES
> 18 VG R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1

j'ai commencé un bout de code mais il est vaiment degueu...
J'ai nettoyé la premiere ligne des espaces, puis je voudrais récuperer les 3dupon" "Alice" "Noelle" (cela peut varier si 2 prenom ou pas).
Je voudrais recuperer ensuite les infos de la ligne avec le ">" devant (18 et VG peuvent changer). " R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1 "

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Test()
    Dim Phrase As String
    Dim Index As Integer
    Dim Starter As Integer
    Dim Mot As String
    Dim a As Range
    Dim lig As Long
    Dim col As Long
    Dim inc As Integer
 
 
 
For lig = 3 To 40
 
If Cells(lig, 1).Value Like "*M.*" Or Cells(lig, 1).Value Like "*MME*" Then
 
Phrase = Cells(lig, 1).Value
'Phrase = "ttryt     tury  yuyy yyu   "
 
Phrase = LTrim(Phrase)
Phrase = RTrim(Phrase)
Phrase = Replace(Phrase, "      ", " ")
Phrase = Replace(Phrase, "     ", " ")
Phrase = Replace(Phrase, "    ", " ")
Phrase = Replace(Phrase, "   ", " ")
Phrase = Replace(Phrase, "  ", " ")
 
 
 
 
MsgBox Phrase
 ' Suppression des doubles espaces
    'Phrase = Trim(Me.desc_ang.Value)
 
      Starter = 1
    inc = 0
    Index = InStr(Starter, Phrase, " ")
    Do While inc >= 3
        Mot = Mid(Phrase, Starter, Index - Starter)
        MsgBox Mot
        MsgBox inc
        inc = inc + 1
        Starter = Index + 1
        Index = InStr(Starter, Phrase, " ")
    Loop
    End If
     Next lig
 
End Sub

**unparia** · 05/03/2018, 20h17

Bonjour

Le problème c'est qu'une seule colonne est utilisée. Et sur chaque ligne il y a des phrases et non pas une seule valeur par cellule.

Situation typique.
Plusieurs données distinctes dans un seul "champ" = aucune possibilité d'extraire avec assurance chacune des données = conception à revoir en amont.
Je comprends bien que tu as "pioché" ces données depuis un .pdf et que tu subis.
Mais dans ce cas : désolé -->> traiter cela informatiquement relève de l'utopie.

**patricktoulon** · 05/03/2018, 20h51

re

MME Dupont ALICE NOELLE DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES
> 18 VG R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1

depuis quand excel ou vb possede un dictionnaire de nomprenom

comment veux tu quue excel ou vba devine ou commence et s'arrete le prenom

maintenant si tu me dis que ca commence toujours par Mr ou Mme ou Miss etc... et que apres le nom ce qui suit commence toujour par "DPE......"
alors la oui on peut effectivement faire quelque chose

sinon WALOUH WALOUH

Comme on te la dit revoir la conception en amont

**gandolfi** · 06/03/2018, 07h03

bonjour, merci pour vos réponses.
effectivement je subis le pdf....

la 1ere ligne qui m'interesse commence toujours par "M." ou "MME". c'est mon 1er repérage.
- Je veux recuperer le nom qui suit, le prenom et éventuellement le 3eme prenom s'il existe. Le deuxieme repérage c'est qu'il y a toujours les caracteres DPE avant le dernier prénom (meme parfois collé à la fin du prénom....)
MME DUPONT ALICE DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES
MME DUPONT ALICE NOELLEDPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES
M. MARTIN GERARDDPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES

- La deuxieme ligne qui m'interesse commence toujours par "> 2 chiffres 2 lettres". je dois récuperer ce qui se trouve après en rouge
> 18 VG R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1

je pense que c'est un jeu de regex ou bien de fignolage en se repérant avec les caracteres avant et après. Mais ce n'est pas évident car je ne maitrise pas encore les fonctions.

**unparia** · 06/03/2018, 08h31

je voudrais récuperer les "dupon" "Alice" "Noelle" (cela peut varier si 2 prenom ou pas).

Signifie clairement que tu ne veux pas extraire "dupon Alice Noelle", mais extraire séparément "dupon", "Alice" et "Noelle" et donc séparément le patronyme entre autres.
Si tel est le cas -->> mission impossible, y compris manuellement (existent les patronymes composés, etc ... et les patronymes qui ont la même orthographe qu'un prénom)

EDIT : tiens (en l'honneur d'un peintre que j'aime beaucoup) :
Quinquela Martín Benito
Il se trouve que tant Martín que Benito sont aussi des prénoms.
Alors ?
le patronyme est-il Quinquela avec les prénoms Martín et Benito ?
ou est-il Quinquela Martín avec pour seul prénom Benito ?
Et ce n'est ni le cas le plus complexe, ni un cas rare ...

**gandolfi** · 06/03/2018, 09h01

je veux recuperer "DUPONT", le nom est toujours en premier. Puis le ou les 2 prénoms qui suivent. Soit ensemble "ALICE NOELLE" ou que "ALICE" s'il n'y en a qu'un. C'est DPE qui peut servir à determiner la fin de chaine.

Avec ce code ci-dessous j'arrive déja à nettoyer les espaces et à separer les noms et prénoms.
- Il faudrait que je puisse rajouter une condition ou un "nettoyage" si le prenom et DPE sont collées.
- Que le mot 2 soit assigné à la valeur "NOM".
- Que le mot 3 (et 4 s'il existe) soit assigné à la valeur "prénom"
J'irai ensuite faire une recherche dans mon fichier adherent avec le nom et prenom pour inserer les infos qui suivent apres "> 2chiffres 2 lettres"

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Test()
    Dim Phrase As String
    Dim Index As Integer
    Dim Starter As Integer
    Dim Mot As String
    Dim a As Range
    Dim lig As Long
    Dim col As Long
    Dim inc As Integer
 
For lig = 3 To 40
 
If Cells(lig, 1).Value Like "*M.*" Or Cells(lig, 1).Value Like "*MME*" Then
 
Phrase = Cells(lig, 1).Value
'Phrase = "ttryt     tury  yuyy yyu   "
 
Phrase = LTrim(Phrase)
Phrase = RTrim(Phrase)
Phrase = Replace(Phrase, "      ", " ")
Phrase = Replace(Phrase, "     ", " ")
Phrase = Replace(Phrase, "    ", " ")
Phrase = Replace(Phrase, "   ", " ")
Phrase = Replace(Phrase, "  ", " ")
 
MsgBox Phrase
 ' Suppression des doubles espaces
    'Phrase = Trim(Me.desc_ang.Value)
 
   ' texte = "MME  BRIDONNEAU          CECILIA        DPEIGC PRO 9740380V"
    Starter = 1
    inc = 0
    Index = InStr(Starter, Phrase, " ")
    Do While inc < 4
        Mot = Mid(Phrase, Starter, Index - Starter)
        MsgBox Mot
        inc = inc + 1
        Starter = Index + 1
        Index = InStr(Starter, Phrase, " ")
    Loop
    End If
     Next lig

**unparia** · 06/03/2018, 09h04

je veux recuperer "DUPONT" puis le ou les 2 prénoms ensemble "ALICE NOELLE" ou que "ALICE" C'est DPE qui servira à determiner la fin de chaine.

Et il est alors (me relire) impossible de le faire de manière totalement fiable !
Y compris en intervention humaine.

**Marc-L** · 06/03/2018, 09h28

Envoyé par gandolfi

C'est DPE qui peut servir à determiner la fin de chaine.

Donc si "DPE" est présent dans toutes les lignes Monsieur, Madame, une p'tite démonstration :

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
Sub Demo()
    For Each V In Array("MME Dupont ALICE NOELLE DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES", _
                        "Ligne biton n°1", "Ligne bidon suivante", "Encore une ligne bidon", "Toujours bidon", _
                        "> 18 VG R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1")
                    W = Split(V)
        Select Case W(0)
               Case "M.", "MME"
                    W = Split(Split(V, " DPE ")(0))
                    W(0) = ""
               Case ">"
                    W(0) = "":  W(1) = "":  W(2) = ""
               Case Else
                    W = ""
        End Select
         If IsArray(W) Then Debug.Print LTrim(Join(W))
    Next
End Sub

___________________________________________________________________________________________________________

Merci de cliquer sur

en bas à droite de chaque message ayant aidé puis sur

pour clore cette discussion …

**gandolfi** · 06/03/2018, 09h36

Merci MARC. J'essaye de comprendre ton code.
-On peut remplacer le texte dans ARRAY par un range (cellule 1 à 100000 par exemple) ?
- Tu recuperes comment les valeurs nom, prenom ?

J'ai codé cela pour l'instant et j'arrive à recuperer nom, prenom1, prenom 2 et nettoyer DPE. Mais c'est un code sale...

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Function PartieGauche(ByVal Str As String, ByVal Sep As String) As String
Dim n As Byte
 
n = InStr(Str, Sep)
If n > 0 Then Str = Left(Str, n - 1)
PartieGauche = Str
End Function
 
Sub Test()
    Dim Phrase As String
    Dim Index As Integer
    Dim Starter As Integer
    Dim Mot As String
    Dim a As Range
    Dim lig As Long
    Dim col As Long
    Dim inc As Integer
    Dim nom As String
    Dim prenom As String
 
For lig = 127310 To 127330
'For lig = 127537 To 127538
 
If Cells(lig, 1).Value Like " M.*" Or Cells(lig, 1).Value Like " MME*" Then
 
Phrase = Cells(lig, 1).Value
 
Phrase = LTrim(Phrase)
Phrase = RTrim(Phrase)
Phrase = Replace(Phrase, "      ", " ")
Phrase = Replace(Phrase, "     ", " ")
Phrase = Replace(Phrase, "    ", " ")
Phrase = Replace(Phrase, "   ", " ")
Phrase = Replace(Phrase, "  ", " ")
 
MsgBox Phrase
 
   ' texte = "MME  BRIDONNEAU          CECILIA        DPEIGC PRO 9740380V"
    Starter = 1
    inc = 0
    Index = InStr(Starter, Phrase, " ")
 
 Do While inc < 4
        Mot = Mid(Phrase, Starter, Index - Starter)
        MsgBox Mot
        inc = inc + 1
        If inc = 2 Then nom = Mot
        If inc = 3 Then prenom1 = Mot
        If inc = 4 Then prenom2 = Mot
 
        Starter = Index + 1
        Index = InStr(Starter, Phrase, " ")
    Loop
    End If
     Next lig
 If prenom2 Like "DPE*" Then prenom2 = "0"
 prenom1 = PartieGauche(prenom1, "DPE")
 prenom2 = PartieGauche(prenom2, "DPE")
 
 If prenom1 Like "*DPE*" Then prenom2 = "0"
 
 
MsgBox "nom :" & nom & "prenom1 :" & prenom1 & "prenom2" & prenom2
 
 
End Sub

**unparia** · 06/03/2018, 09h41

J'ai codé cela pour l'instant et j'arrive à recuperer nom, prenom1, prenom 2 et nettoyer DPE

Oui ?
Hé bien : montre moi quel patronyme et quel(s) prénom(s) tu "récupères" avec ton code de :

M. QUINQUELA MARTIN BENITO DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES

(juste pour t'ouvrir les yeux).

**Marc-L** · 06/03/2018, 09h41

En suivant la progression de mon code en mode pas à pas (touche F8), bien regarder le contenu
de la variable W dans la fenêtre Variables locales avant d'exécuter la ligne de code n° 15 …

**gandolfi** · 06/03/2018, 10h06

Envoyé par Marc-L

En suivant la progression de mon code en mode pas à pas (touche F8), bien regarder le contenu
de la variable W dans la fenêtre Variables locales avant d'exécuter la ligne de code n° 15 …

Merci pour l'astuce et le code propre

genial le case pour separer les mots c'est plus propre. Désolé je ne vois pas trop pour la ligne 15.

J'ai un peu modifié pour nettoyer les prenoms et le souci du DPE eventuellement collé au prenom.
- Par contre comment recuperer l'ensembles des infos d'un seul bloc ou de w(3) à w(6) pour la ligne avec ">" ?
- Comment mettre un range de cellule de la colonne 1 dans Array () ?

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
24
25
26
27
Sub Demo()
Dim prenom1 As String, prenom2 As String, nom As String
 
    For Each V In Array("MME Dupont ALICE NOELLEDPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES", _
                        "Ligne biton n°1", "Ligne bidon suivante", "Encore une ligne bidon", "Toujours bidon", _
                        "> 18 VG R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1")
                    W = Split(V)
        Select Case W(0)
               Case "M.", "MME"
                    W = Split(Split(V, " DPE ")(0))
                    W(0) = ""
                    nom = W(1)
                    prenom1 = W(2)
                    prenom2 = W(3)
 
                    If prenom2 Like "DPE*" Then prenom2 = "0"
                    prenom1 = PartieGauche(prenom1, "DPE")
                    prenom2 = PartieGauche(prenom2, "DPE")
 
               Case ">"
                    W(0) = "":  W(1) = "":  W(2) = ""
               Case Else
                    W = ""
        End Select
         If IsArray(W) Then Debug.Print LTrim(Join(W))
    Next
End Sub

**patricktoulon** · 06/03/2018, 10h15

re

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub test_vite_fait()
texte = texte & "MME DUPONT ALICE  DPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES"
 texte = texte & "MME DUPONT yollande NOELLEDPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES > 18 VG  R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1 "
 texte = texte & "M. MARTIN GERARDDPE TPD 7940115G X.C.C.PU CLAIRE LOUIS LA PLAINE DES LIANES"
texte = Replace(Replace(texte, "MME ", "xxx"), "M. ", "xxx")
tabl = Split(texte, "xxx")
For i = 1 To UBound(tabl)
Debug.Print "nom et prenom :" & vbCrLf & Split(tabl(i), "DPE")(0)
If InStr(tabl(i), ">") > 0 Then Debug.Print Trim(Mid(tabl(i), InStrRev(tabl(i), ">") + 7, Len(tabl(i))))
Debug.Print vbCrLf
Next
End Sub

resultat dans debug

nom et prenom :
DUPONT ALICE

nom et prenom :
DUPONT yollande NOELLE
R OUEST (sur étab. 9740929S) TIT.R.RIG SS SPEC. 4076 TDP 10 7.800 B:1

nom et prenom :
MARTIN GERARD

**Pierre Fauconnier** · 06/03/2018, 11h48

Salut.

Tu pourrais utiliser les regex, éventuellement.

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
24
25
26
Sub Test()
  Dim Matches As Object
  Dim Elements
  Dim i As Long
  Dim Cell As Range
 
  For Each Cell In Range("a1:a2")
    Set Matches = GetRegExpMatches(Cell.Value, "^((.+) +)+DPE")
      If Matches.Count > 0 Then
        Elements = Split(Application.Trim(Matches(0).SubMatches(0)))
        For i = 0 To UBound(Elements)
          Cell(1, i + 2) = Elements(i)
        Next
      End If
  Next Cell
End Sub
 
Function GetRegExpMatches(Value As String, Pattern As String) As Object
  Dim regex As Object
  Dim Matches As Object
 
  Set regex = CreateObject("VBScript.RegExp")
  regex.Pattern = Pattern
  regex.Global = True
  Set GetRegExpMatches = regex.Execute(Value)
End Function

Si le pattern est rencontré, le tableau Elements reprend les mots se trouvant avant DPE. [EDIT] Code modifié pour tenir compte d'éventuels espaces en double ou en triple...[/EDIT]

Nom : 2018-03-06_123947.png
Affichages : 748
Taille : 5,3 Ko

Nom : 2018-03-06_123947.png
Affichages : 748
Taille : 5,3 Ko

**gandolfi** · 06/03/2018, 13h14

Merci pour toutes vos reponses.

- Pour l'instant je suis en train de tester la code de MArc. Mais il me manque le range pour selctionner les cellules dans le ARRAY et la maniere de recuperer tous les mots apres "> 2lettres 2chiffres" ( W(3) W(4) .....)

- Pour la solution de Pierre je vais regarder mais je ne sais pas comment assigner une valeur aux variable prenom1, prenom2, nom et le texte après "> 2lettres 2chiffres"

- La solution de Patrick est un peu compliqué pour moi

**Pierre Fauconnier** · 06/03/2018, 13h25

En fait, même pas besoin de regex.

Si j'ai bien compris que tes lignes commencent systématiquement par une mention civile (mr, mme, mlle, ...) puis par le nom et les prénoms avec x espaces entre puis x espaces puis DPE, tu peux utiliser le code suivant, le tableau elements te donnant en (0) le terme civil, le (1) le nom et les suivants les prénoms... (Je les ai mis dans des cellules, mais tu en fais ce que tu veux)

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
Sub Test()
  Dim Cell As Range
  Dim Pos As Long
  Dim Elements
  Dim i As Long
 
  For Each Cell In Range("a1:a2")
    Pos = InStr(1, Cell.Value, "DPE", vbTextCompare)
    If Pos > 0 Then
      Elements = Split(Application.Trim(Left(Cell.Value, Pos - 1)), " ")
      For i = 0 To UBound(Elements)
        Cell(1, i + 2).Value = Elements(i)
      Next i
    End If
  Next
End Sub

Envoyé par gandolfi

[...]je ne sais pas comment assigner une valeur aux variable prenom1, prenom2[...]

Perso, je ne jouerais pas avec des variables prenom1, prenom2 puisque tu pourrais en avoir plusieurs. C'est l'intérêt du SPLIT qui crée un tableau avec le nombre voulu d'éléments. Si ton tableau contient 3 élements, c'est que la personne n'a qu'un prénom (Titre civil, Nom, prénom). Si ton tableau contient 5 éléments, c'est que la personne a trois prénoms (titre civil, nom, prénom1, prénom2, prénom3)

Invité · 06/03/2018, 14h24

Bonjour,

je suis pas certain d'avoir compris, je jette comme ça !

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
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Public Cn As Object
Sub test()
Set Cn = OpenConnetion(ThisWorkbook.Path & "\Prénom.xlsx", True)
Dim T, FinPnom As Boolean
ThisWorkbook.Sheets("Feuil1").Range("B:E").Clear
Set r = ThisWorkbook.Sheets("Feuil1").Range("A1").CurrentRegion
For i = 2 To r.Rows.Count
FinPnom = False
    T = Split(Application.Trim(r(i, 1).Text) & Space(10))
    r(i, 1).Offset(0, 1) = T(0): r(i, 1).Offset(0, 2) = T(1)
    For x = 2 To UBound(T)
    If Trim("" & T(x)) = "" Then Exit For
        If IsPrenom(Trim("" & T(x))) And Not FinPnom Then
         If Trim("" & r(i, 1).Offset(0, 3)) = "" Then r(i, 1).Offset(0, 3) = T(x) Else r(i, 1).Offset(0, 3) = r(i, 1).Offset(0, 3) & "-" & T(x)
        Else
            FinPnom = True
            If Trim("" & r(i, 1).Offset(0, 4)) = "" Then r(i, 1).Offset(0, 4) = T(x) Else r(i, 1).Offset(0, 4) = Trim(r(i, 1).Offset(0, 4)) & " " & T(x)
        End If
    Next
Next
End Sub
Public Function OpenConnetion(FichierXls As String, AvecTitre As Boolean) As Object
'ouvre la connexion au fichier Excel
'FichierXls non et chemin complet du fichier
'AvecTitre précise si la première ligne de l'onglet est les entête de colonnes ou pas
'rzutourne la connexion
On Error Resume Next
Dim HDR
If Dir(FichierXls) = "" Then MsgBox FichierXls & vbCrLf & "Pas trouvé": Exit Function ' versifie si le fichier existe
HDR = Array("No", "Yes")
Set OpenConnetion = CreateObject("ADODB.Connection") 'Instancie un objet adosb c'est mieux que d'utiliser le références
With OpenConnetion
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & FichierXls & ";Extended Properties=""Excel 12.0 Xml;HDR=" & HDR(Abs(AvecTitre)) & ";IMEX=1;"""
        .Open
        If Err Then
            MsgBox Err.Description
            Set OpenConnetion = Nothing
        End If
        Err.Clear
        On Error GoTo 0
End With
End Function
Public Function OpenRecordSet(Sql, Cn As Object) As Object 'Retourne un recordset
'Retourne un RecordeSet
On Error Resume Next
Set OpenRecordSet = CreateObject("ADODB.Recordset")
OpenRecordSet.Open Sql, Cn, 1, 3 'ouvre un recordset sur la requête SQL pour la connexion en lecteur écriture et ajou dynamique
If Err Then
    MsgBox Err.Description
Set OpenRecordSet = Nothing
End If
Err.Clear
On Error GoTo 0
End Function
Public Function IsPrenom(Pnm As String) As Boolean
Dim Rs As Object
Set Rs = OpenRecordSet("select * from [Prénom$] Where [Prénom]='" & Replace(Pnm, "'", "''") & "'", Cn)
IsPrenom = Not (Rs.EOF)
Rs.Close: Set Rs = Nothing
End Function