begin process at 2008 07 04 09:03:09
1 204 518 membres
60 nouveaux aujourd'hui
14 116 membres club

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum.
Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

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


Information sur la source

Catégorie :Texte Classé sous : découpage, texte, longueur, vbcrlf Niveau : Débutant Date de création : 23/06/2000 Vu : 6 437

Note :
10 / 10 - par 1 personne
10,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10

Commentaire sur cette source (0)
Ajouter un commentaire et/ou une note

Description

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

Source

  • 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
 
    Aucun commentaire pour le moment.

Ajouter un commentaire

Pub



Appels d'offres

CalendriCode

Juillet 2008
LMMJVSD
 123456
78910111213
14151617181920
21222324252627
28293031   

VS Express FR Gratuit !

VS Express en français et 100% gratuit !

Téléchargements

Logiciels à télécharger sur le même thème :

Boutique

Boutique de goodies CodeS-SourceS