Decoupage d'un texte sur une longeur de ligne précise


Commenter

Contenu du snippet

Découpe une chaine trop longue en une nouvelle chaine, avec à la position "coupe" est inscrit un retour chariot

Source / Exemple : 


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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (blq)