XL 2016 Découpage de texte

[alain160]

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

 

[patricktoulon]

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

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

 

[alain160]

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

 

[patricktoulon]

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]

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]

re
pour le formatage c'est normal du texte c'est du texte pas du format
pour la réutilisation tu peux en faire une simple fonction avec argument
je vois ca plus tard je suis sur un autre sujet là

 

[patricktoulon]

re
bonsoir
en fonction ça pourrait être ceci

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

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