Ce module complet propose des fonctions afin de mettre en forme une adresse. Il permet par exemple de transformer :
46 bis Rue de la Paix par Rue de la Paix ou bien Paix (Rue de la).
Dans un module placez le code suivant :
Function fNomVoie(ByVal str As String) As String
Dim strMotsClés As String, strMotsSecondaires As String, _
strMot As String
If str = "" Then Exit Function
strMotsClés = Trim(str)
strMotsClés = fVoieSansNum(strMotsClés)
strMot = fPremierMot(strMotsClés)
Do Until fMotClé(strMot)
strMotsSecondaires = strMotsSecondaires & " " & strMot
strMotsClés = LTrim(Right(strMotsClés, Len(strMotsClés) - Len(strMot)))
strMot = fPremierMot(strMotsClés)
Loop
If Len(LTrim(strMotsSecondaires)) > 0 Then _
strMotsSecondaires = " (" & LTrim(strMotsSecondaires) & ")"
fNomVoie = strMotsClés & strMotsSecondaires
End Function
Function fPremierMot(str As String)
Dim lng As Long
Dim strMot As String
For lng = 1 To Len(str)
Select Case Mid(str, lng, 1)
Case " "
strMot = Left(str, lng - 1)
fPremierMot = strMot
Exit Function
Case "'"
strMot = Left(str, lng)
fPremierMot = strMot
Exit Function
End Select
Next lng
fPremierMot = str
End Function
Function fMotClé(str As String) As Boolean
Select Case str
Case "Rue", "Boulevard", "Avenue", "Chemin", "Passage", "Traverse", _
"Route", "Place", "Allée", "Allées", "Esplanade", "Quai", _
"-", "le", "la", "les", "l'", "du", "de", "des", "d'", _
fMotClé = False
Case Else
fMotClé = True
End Select
End Function
Function fVoieSansNum(ByVal Voie As String) As String
Dim str As String
Dim bte As Byte, bteFinNum As Byte
Voie = Replace(Voie, ",", "")
str = Left$(Voie, 1)
If Not IsNumeric(str) Then
fVoieSansNum = Voie
Else
bte = 1
Do
If IsNumeric(str) Then
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop Until str <> " "
Else
Select Case str
Case "-", "&"
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
If Not IsNumeric(str) Then
Exit Do
End If
Case "b"
If Mid$(Voie, bte, 3) = "bis" Then
Select Case Mid$(Voie, bte + 3, 1)
Case " "
bte = bte + 3
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
Case "-", "&"
bte = bte + 3
str = Mid$(Voie, bte, 1)
Case Else
Exit Do
End Select
Else
Select Case Mid$(Voie, bte + 1, 1)
Case " "
bte = bte + 1
bteFinNum = bte
Do
bte = bte + 1
str = Mid$(Voie, bte, 1)
Loop While str = " "
Case "-", "&"
bte = bte + 1
str = Mid$(Voie, bte, 1)
Case Else
Exit Do
End Select
End If
Case Else
Exit Do
End Select
End If
Loop
fVoieSansNum = Trim$(Right$(Voie, Len(Voie) - bteFinNum))
End If
End Function
Utilisation des fonctions :
Msgbox fVoieSansNum("90-92 Rue Meynadier")
Affiche : Rue Meynadier
Msgbox fNomVoie("90-92 Rue Meynadier")
Affiche : Meynadier (Rue)
Remarques :
Select Case str
Case "Rue", "Boulevard", "Avenue", "Chemin", "Passage", "Traverse", _
"Route", "Place", "Allée", "Allées", "Esplanade", "Quai", _
"-", "le", "la", "les", "l'", "du", "de", "des", "d'", _
fMotClé = False
Case Else
fMotClé = True
End Select
Vous pouvez compléter vous-même la fonction fMotClé en ajoutant dans le premier Case, des mots "non-clés" (c'est à dire à ne pas considérer comme des noms de voie).
Vous trouverez une base de données utilisant ces fonctions dans une requête et un formulaire dans le fichier zip télechargeable.
| 
