Public Type N_Pn
Nom As String
PNom As String
End Type
Public Cn As Object, FichierXls As String
Public Sub OpenConnetion()
'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 Sub ' versifie si le fichier existe
Set Cn = CreateObject("ADODB.Connection") 'Instancie un objet adosb c'est mieux que d'utiliser le références
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & FichierXls & ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1;"""
.Open
If Err Then
MsgBox Err.Description
Set Cn = Nothing
End If
Err.Clear
On Error GoTo 0
End With
End Sub
Public Function OpenRecordSet(Sql) As Object 'Retourne un recordset
If TypeName(Cn) = "Nothing" Then OpenConnetion
'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
Function IsPrenom(Pnm As String) As Boolean
FichierXls = ThisWorkbook.Path & "\Prénom.xlsx"
Dim Rs As Object
Set Rs = OpenRecordSet("select * from [Prénom$] Where [Prénom]='" & Replace(Pnm, "'", "''") & "'")
IsPrenom = Not (Rs.EOF)
Rs.Close: Set Rs = Nothing
End Function
Sub b()
Debug.Print NomPnom("Jean-Robert Marcel", False)
End Sub
Function NomPnom(txt, PNom As Boolean)
Dim t, i As Integer, Start As Boolean, Fin As Boolean, Nm As Boolean, Ispn As Boolean
t = Split(Replace(txt, "-", " ") & " ", " ")
For i = 0 To UBound(t) - 1
Ispn = IsPrenom(CStr(t(i)))
If Not Ispn Then Nm = True
If Ispn = PNom Then
Start = True
If Start = True And Fin = False Then
If PNom Then
If CStr(NomPnom) <> "" Then NomPnom = NomPnom & "-"
End If
NomPnom = NomPnom & " " & CStr(t(i))
End If
Else
If Start = True Then Fin = True
End If
Next
If Not Nm Then
If PNom Then
t = Split(txt & " ", " ")
NomPnom = ""
For i = 0 To UBound(t) - 1
If CBool(InStr(1, t(i), "-")) Then NomPnom = t(i)
Next
Else
NomPnom = ""
For i = 0 To UBound(t) - 1
If Not CBool(InStr(1, t(i), "-")) Then NomPnom = t(i)
Next
If NomPnom = "" Then NomPnom = txt
End If
End If
End Function