begin process at 2012 02 16 18:04:50
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Texte

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

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


 Information sur la source

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

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

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

Auteur : blq

Ecrire un message privé
Site perso
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
 



 Sources du même auteur

Source .NET (Dotnet) UTILISATION DE SORTEDLIST POUR TRIER UNE COLLECTION DE VALEU...
ADDITION OU SOUSTRACTION DE DEUX HEURES DE TYPE HH:MM:SS
DATE DU JOUR
DIFFÉRENCE ENTRE DEUX HEURES DE FORMAT HH:MM:SS
EXTRACTION D'INFORMATION SUR UNE HEURE HH:MM:SS

 Sources de la même categorie

Source avec Zip Source avec une capture MASQUE DE SAISIE NUMÉRIQUE par acive
Source avec Zip Source .NET (Dotnet) COMPTEUR DE NOMBRE DE MOTS DANS UN TEXTE par alpha5
Source avec Zip Source avec une capture HM - BLOCNOTE par hassenmajor
Source .NET (Dotnet) [VB.NET] CLASS DE COLORATION SYNTAXIQUE "ON THE FLY" par huzima
Source avec Zip Source avec une capture PERSONNALISEZ VOS BOÎTES DE MESSAGE (X)HTML par medjahedScript

 Sources en rapport avec celle ci

Source avec Zip Source avec une capture VBA MASQUE DE SAISIE NUMÉRIQUE par acive
Source avec Zip Source avec une capture Source .NET (Dotnet) CONVERTIR UN SOURCE CSHARP EN VBNET par gillardg
Source avec Zip Source avec une capture LIVE (( TRAITEMENT DE TEXTE )) par crossblade
Source avec Zip Source avec une capture AH VALA UN BON EDITEUR DE TEXTE : NODE EDITOR (PETITE MISE A... par Zeratul456
RETOUR A LA LIGNE par Nix

Commentaires et avis

Aucun commentaire pour le moment.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Fichiers texte de longueur Fixe [ par Docck ] Salut les VBMan,Je cherche à importer dans access un fichier texte ayant ses champs délimités par des longueurs fixes.La contrainte est que je ne dois Longueur d'un texte dans une richtextbox [ par elaphe ] Bonjour,Merci de m'indiquer comment déterminer la longueur (en twips par exple) d'une ligne de texte formaté dans une richtextbox. Attention il ne s' API ET TEXTE [ par stefsoft ] je dessine par les API un texte avec Drawtext , et je voudrais connaitre la longueur en pixels de ma chaine de caractère pour fixer la longueur de mon Convertir un fichier texte (avec des ;) en longueur fixe [ par eren ] J'ai un fichier issu d'Excel au format CSV, c.a.d avec des points virgules entre chaque champEx .Renaud;EricDupond;PaulJ'ai besoin de convertir ce fic vbCrlf me vire la mise en forme d'un texte [ par michmuch2000 ] Salut,dès que j'envoi une commande de type RichTextBox1 = RichTextBox1 & vbCrlf en plein millieu d'un RichTexBox contenant du texte mis en forme, c'es Longueur en pixel d'un Texte [ par comprateur ] Longueur en pixel d'un Texte:Bonjour, je dois traduire des étiquettes de l'anglais au francais sans dépasser la longueur de l'étiquette d'origine meme Découpage de texte [ par dam94 ] Bonjour,J'affiche un text dans une text box, et dans ce texte il y a des valeurs avec lesquels je voudrais faire un graphe.Exemple de texte :" 2min à Comment connaitre la longueur d'un texte en pixel ? [ par salazar ] J'affiche du texte dans un ListBox, et je souhaite tronquer le texte dès qu'il a atteind une certaine longueur.Cette longueur est liée à la police, au gestion champs vide [ par tayfun ] Salut à tous,Je vous explique mon soucis : J'extrait des données depuis un fichier qui se trouve sur un As400 et je les concatene dans un fichier text Longueur d'une tabulation dans fichier texte [ par Apolinaire ] Bonjour,Quand j'écris une tabulation (vbTab) dans un fichier texte à l'aide de WriteLine, cette tabulation fait toujours 8 espaces de longueur.Y'a-t-i


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,796 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales