XL 2016 Découpage de texte

alain160

XLDnaute Nouveau
Bonjour,
J’ai un long texte placé dans la cellule A1 par exemple.
Je souhaiterais trouver une macro qui permet de découper ce long texte sur 4 ou 5 colonnes (ou une longueur de x caractères sans couper les mots) et sur le nombre de ligne nécessaire en fonction de la taille du texte.
Avez-vous une idée ?
Merci par avance
Cordialement
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir
un exemple
en considérant que les mots sont séparés par des espaces
nbchar est la limite du nombre de caractères par lignes
si ça dépasse la ligne fait moins de caractères et on ajoute une ligne

VB:
Sub test()
    Dim chaine$, nbchar&, T, Tc(), i&, a&
    
    chaine = "en considérant que les mots sont séparés par des espaces nbchar est la limite du nombre de caractères par lignes "
    chaine = chaine & "si ça dépasse la ligne fait moins de caractères et on ajoute une ligne"
    
    nbchar = 25
    T = Split(chaine, " ")
    a = 0
    ReDim Preserve Tc(0)
    For i = 0 To UBound(T)
        If Len(Tc(a) & T(i)) <= nbchar Then Tc(a) = Tc(a) & " " & T(i) Else i = i - 1: a = a + 1: ReDim Preserve Tc(0 To a)
    Next
    MsgBox Join(Tc, vbCrLf)
End Sub
voila ;)
 
Dernière édition:

alain160

XLDnaute Nouveau
merci patricktoulon
La macro fonctionne bien mais lorsque je colle le texte découpé ( visible dans la boite de dialogue Msgbox) tout ce texte se retrouve dans 1 seule colonne.
Je souhaiterais qu'il s'affiche sur plusieurs colonnes ( déterminé par la valeur nbchar) et sur plusieurs lignes.

A1= texte d'origine très long
à la sortie de la macro
A1= texte de longueur nbcar (qui dépasse la colonne A)
A2= suite du texte de longueur nbcar ( sans coupure de mots)
A3= suite du texte si nécessaire et ainsi de suite jusqu'au dernier mot

Bien cordialement
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
le msgbox est un join c'est juste pour ton visuel
pour mettre le texte dans une range c'est
exemple colonne
[A1].resize(ubound(tc)+1,1).value=application.transpose(tc)'met la coupe dans la colonne A
exemple ligne
[A1].resize(1,ubound(tc)+1).value=tc'met la coupe dans la ligne 1

à la place du message box dans mon code
 

alain160

XLDnaute Nouveau
merci @patricktoulon pour votre réponse rapide.
ça fonctionne bien
Une dernière petite question
Le texte coupé ne conserve pas la police de caractère du texte d'origine sur les lignes 2 et suivante.
Si le texte d'origine se trouve sur A1 et que les cellules A2 , A3 et suivantes ont été formatées antérieurement par une autre polices le texte inséré conserve cette police?
Peut on y remédier?
Je souhaiterais couper plusieurs textes et donc lancer plusieurs fois ma macro dans ma feuille.
cette macro peut elle se lancer lorsque je met le curseur au début de chacun des( longs) textes à couper.
Merci par avance et désolé d'abuser de votre compétence
cordialement.
 

patricktoulon

XLDnaute Barbatruc
re
bonsoir
en fonction ça pourrait être ceci
VB:
Function maxCharbyrow(chaine$, Optional NombreDeCaracteres& = 10, Optional index& = 1000)
    Dim T, Tc(), i&, a&
    T = Split(chaine, " ")
    a = 0
    ReDim Preserve Tc(0)
    For i = 0 To UBound(T)
        If Len(T(i)) > NombreDeCaracteres Then MsgBox "il y a un mots plus grand que le nombrede caracteres demandé": maxCharbyrow = Array(False): Exit Function
        If Len(Tc(a) & T(i)) <= NombreDeCaracteres Then Tc(a) = Tc(a) & " " & T(i) Else i = i - 1: a = a + 1: ReDim Preserve Tc(0 To a)
    Next
    If index = 1000 Then maxCharbyrow = Tc Else maxCharbyrow = Tc(index)
End Function

la formule de base pour une cellule

exemple la ligne 1 de 25 caractères max
=maxCharbyrow($A$2;25;0)

exemple la ligne 2 de 25 caractères max
=maxCharbyrow($A$2;25;1)

si on veut l'utiliser en vba et récupérer toutes les lignes dans une variable tableau

VB:
Sub test()
    Dim chaine$, Tc
    chaine = "en considérant que les mots sont séparés par des espaces nbchar est la limite du nombre de caractères par lignes "
    chaine = chaine & "si ça dépasse la ligne fait moins de caractères et on ajoute une ligne"
    Tc = maxCharbyrow(chaine, 15) 'toutes les ligne sont dans Tc
    MsgBox Join(Tc, vbCrLf) 'apercu dans un message
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 732
Messages
2 081 995
Membres
101 857
dernier inscrit
mt60400