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
| Private Sub TextBox1_Change()
Dim str_test As String
Dim Ch
Dim ADRESSEGLOBALE As String
Dim Mot As String
Dim Motcherche As String
'supprimer les virgules et retirer les doubles espaces
ADRESSEGLOBALE = func_DelAllSpace(Textbox1.Value)
'Troncature à 35
Mot = ADRESSEGLOBALE
Ch = Split(Mot, " ")
Motcherche = Ch(UBound(Ch))
TextBox2.Value = Libelle1(ADRESSEGLOBALE)
TextBox3.Value = Motcherche
End Sub
Function Libelle1(strString As String) As String
Dim lib As String
Dim charact1 As String
Dim charact2 As String
Dim strString2 As String
Dim intpositioncharact3 As Integer
charact1 = Mid(strString, 34, 1)
charact2 = Mid(strString, 35, 1)
strString2 = Mid(strString, 1, 34)
intpositioncharact3 = LastOccurence(strString2, " ")
If charact1 = " " Then
lib = Mid(strString, 1, 34)
End If
If charact2 = " " Then
lib = Mid(strString, 1, 34)
End If
If charact1 <> " " Then
lib = Mid(strString, 1, intpositioncharact3)
End If
Libelle1 = lib
End Function
Function LastOccurence(strString As String, strCharacter As String) As Integer
Dim intPosition As Integer
intPosition = 1
While intPosition <= Len(strString) And strCharacter <> "" And InStr(intPosition, strString, strCharacter) <> 0
intPosition = InStr(intPosition, strString, strCharacter)
LastOccurence = intPosition
intPosition = intPosition + 1
Wend
End Function |
Partager