- Function sDecoupeChaine(ByVal chaine As String, ByVal coupe As Integer, ByVal new_car As String) As String
- Dim pos As Integer, laChaine As String, item As String
- Dim ln As Integer, passage As Integer, decoupe As Integer
-
-
- passage = 0
- laChaine = vbNullString
-
- If Len(Trim(chaine)) > 0 And coupe > 0 And Len(Trim(chaine)) > coupe Then
- Do
- item = sGetLeftChamp(chaine, Chr$(13))
-
- ln = Len(item)
- If ln > coupe Then
- Do
- decoupe = coupe
- pos = 1
-
- ' Recherche d'un caractère blanc avant la séparation par défaut:
- Do
- If StrComp(Left(Right(Left(item, coupe), pos), 1), cESPACE) = 0 Then
- decoupe = coupe - pos
- Exit Do
- End If
-
- pos = pos + 1
- If pos >= coupe Then Exit Do
- Loop
-
- If Len(laChaine) > 0 Then
- If Len(new_car) > 0 Then
- laChaine = laChaine & new_car & vbCrLf & Left(item, decoupe)
- Else
- laChaine = laChaine & vbCrLf & Left(item, decoupe)
- End If
- Else
- laChaine = Left(item, decoupe)
- End If
-
- item = Right(item, Len(item) - decoupe - 1)
-
- If Len(item) = 0 Then
- Exit Do
- ElseIf Len(item) <= coupe Then
- If Len(new_car) > 0 Then
- laChaine = laChaine & new_car & vbCrLf & item
- Else
- laChaine = laChaine & vbCrLf & item
- End If
-
- Exit Do
- End If
- Loop
-
- passage = 0
- Else
- If ln Then
- If Len(laChaine) > 0 Then
- laChaine = laChaine & vbCrLf & item
- Else
- laChaine = item
- End If
-
- passage = 0
- Else
- passage = passage + 1
- ln = 2
-
- If passage = 2 Then
- If Len(laChaine) > 0 Then
- laChaine = laChaine & vbCrLf
- Else
- laChaine = item
- End If
-
- passage = 0
- End If
- End If
- End If
-
- chaine = Right(chaine, Len(chaine) - ln)
-
- If Len(chaine) = 0 Then
- Exit Do
- ElseIf Len(chaine) <= coupe Then
- laChaine = laChaine & vbCrLf & chaine
-
- Exit Do
- End If
- Loop
-
- sDecoupeChaine = laChaine
-
- Exit Function
- End If
-
- sDecoupeChaine = chaine
- End Function
-
Function sDecoupeChaine(ByVal chaine As String, ByVal coupe As Integer, ByVal new_car As String) As String
Dim pos As Integer, laChaine As String, item As String
Dim ln As Integer, passage As Integer, decoupe As Integer
passage = 0
laChaine = vbNullString
If Len(Trim(chaine)) > 0 And coupe > 0 And Len(Trim(chaine)) > coupe Then
Do
item = sGetLeftChamp(chaine, Chr$(13))
ln = Len(item)
If ln > coupe Then
Do
decoupe = coupe
pos = 1
' Recherche d'un caractère blanc avant la séparation par défaut:
Do
If StrComp(Left(Right(Left(item, coupe), pos), 1), cESPACE) = 0 Then
decoupe = coupe - pos
Exit Do
End If
pos = pos + 1
If pos >= coupe Then Exit Do
Loop
If Len(laChaine) > 0 Then
If Len(new_car) > 0 Then
laChaine = laChaine & new_car & vbCrLf & Left(item, decoupe)
Else
laChaine = laChaine & vbCrLf & Left(item, decoupe)
End If
Else
laChaine = Left(item, decoupe)
End If
item = Right(item, Len(item) - decoupe - 1)
If Len(item) = 0 Then
Exit Do
ElseIf Len(item) <= coupe Then
If Len(new_car) > 0 Then
laChaine = laChaine & new_car & vbCrLf & item
Else
laChaine = laChaine & vbCrLf & item
End If
Exit Do
End If
Loop
passage = 0
Else
If ln Then
If Len(laChaine) > 0 Then
laChaine = laChaine & vbCrLf & item
Else
laChaine = item
End If
passage = 0
Else
passage = passage + 1
ln = 2
If passage = 2 Then
If Len(laChaine) > 0 Then
laChaine = laChaine & vbCrLf
Else
laChaine = item
End If
passage = 0
End If
End If
End If
chaine = Right(chaine, Len(chaine) - ln)
If Len(chaine) = 0 Then
Exit Do
ElseIf Len(chaine) <= coupe Then
laChaine = laChaine & vbCrLf & chaine
Exit Do
End If
Loop
sDecoupeChaine = laChaine
Exit Function
End If
sDecoupeChaine = chaine
End Function