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 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
| 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
Dim x As Integer
charact1 = Mid(strString, 30, 1)
charact2 = Mid(strString, 31, 1)
strString2 = Mid(strString, 1, 30)
intpositioncharact3 = LastOccurence(strString2, " ")
x = Len(strString)
If x <= 30 Then
lib = strString
End If
If x > 30 And charact1 <> " " Then
lib = Mid(strString, 1, intpositioncharact3)
End If
If charact1 = " " Then
lib = Mid(strString, 1, 30)
End If
If charact2 = " " Then
lib = Mid(strString, 1, 30)
End If
Libelle1 = lib
End Function
Function Libelle2(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
Dim charact4 As String
Dim charact5 As String
Dim intpositioncharact6 As Integer
Dim strString1 As String
Dim x As Integer
Dim y As Integer
Dim z As Integer
' indification du " " dans la chaine de caracteres
charact1 = Mid(strString, 30, 1)
charact2 = Mid(strString, 31, 1)
strString2 = Mid(strString, 1, 30)
intpositioncharact3 = LastOccurence(strString2, " ")
x = Len(strString)
' extraction des 30 caracteres suivant libelle1 de la chaine sans coupure de mots
If charact1 = " " Then
strString1 = Mid(strString, 31, 31)
End If
If charact2 = " " Then
strString1 = Mid(strString, 31, 31)
End If
If x > 30 And charact1 <> " " And charact2 <> " " Then
strString1 = Mid(strString, intpositioncharact3, 31)
End If
' Création du libelle2
y = Len(strString1)
charact4 = Mid(strString1, 30, 1)
charact5 = Mid(strString1, 31, 1)
intpositioncharact6 = LastOccurence(strString1, " ")
If y <= 30 Then
lib = strString1
End If
If y > 30 And charact4 <> " " And charact5 <> " " Then
lib = Mid(strString1, 1, intpositioncharact6)
End If
If charact4 = " " Then
lib = Mid(strString1, 1, 30)
End If
If charact5 = " " Then
lib = Mid(strString1, 1, 30)
End If
Libelle2 = lib
End Function
Function Libelle3(strString As String) As String
Dim STR1 As String
Dim STR2 As String
Dim STR3 As String
Dim charact1 As String
Dim charact2 As String
Dim intposcharact3 As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
Dim za As Integer
Dim zb As Integer
' longueur libelle2
x = Len(strString)
' identification de " " dans la 3ieme chaine de caractères
charact1 = Mid(strString, 60, 1)
charact2 = Mid(strString, 61, 1)
STR1 = Mid(strString, 1, 60)
intposcharact3 = LastOccurence(STR1, " ")
y = Len(STR1)
z = Len(Libelle1(strString))
za = Len(Libelle2(strString))
zb = z + za
' extraction fin designation
If charact1 = " " Then
STR2 = Mid(strString, 61, 255)
End If
If charact2 = " " Then
STR2 = Mid(strString, 61, 255)
End If
If x > 61 And charact1 <> " " And charact2 <> " " Then
STR2 = Mid(strString, zb, 255)
End If
Libelle3 = STR2
End Function |
Partager