DECOUPAGE D'UN TEXTE SUR UNE LONGEUR DE LIGNE PRÉCISE

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