Discussion :

[chris09300]

bonsoir
est il possible de couper un texte si¡'il est superieur a 90 caracteres, et de mettre la suite du texte sur la ligne suivante avec des espaces devant.
et ainsi de suite sur les 30 lignes suivantes.
merci
cris

[mercatog]

Bonsoir
Essaies ceci (le etxt initial en A1 de feuil3, les résultat à partir de A2 vers le bas)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Test()
Dim Mot As String, Txt As String
Dim i As Integer, j As Integer, Nb As Integer
Dim Tb
 
Nb = 1
j = 2
With Sheets("Feuil3")
    Mot = .Range("A1").Value
    Tb = Split(Mot)
    Do
        Do While Len(Txt) <= Nb And i < UBound(Tb)
            Txt = Txt & " " & Tb(i)
            i = i + 1
        Loop
        .Range("A" & j).Value = Trim(Txt)
        j = j + 1
        Txt = ""
    Loop Until i = UBound(Tb)
End With
End Sub

[JPierreM]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub Test()
Dim depart As Integer
Dim texte As String
Dim nouvellePhrase As String
 
   MsgBox "Découpe une phrase en chaines de 90 caractères maxi" _
   & Chr(13) & "sans couper les mots"
    depart = 5
    texte = [A1]
 
    Do While Len(texte) >= 90
        nouvellePhrase = Left(texte, 90)
        nouvellePhrase = InStrRev(nouvellePhrase, " ")
        Cells(depart, 1) = Left(texte, nouvellePhrase - 1)
        texte = Mid(texte, nouvellePhrase + 1)
        depart = depart + 1
    Loop
 
    Cells(depart, 1) = texte
 End Sub

[chris09300]

bonsoir jpierreM
j'ai utiliser ton code, ca fonctionne, je souhaiterais partir de la cellule B23, car c'est la qu'est ma premiere phrase,
elle se divise bien, et va a la ligne suivante.
mais si j'ai un autre texte en dessous, il faudrait que j'insere une ligne.
comment faire une fois que le texte est bien decouper, que le code recherche, s'il y a un autre texte dans les lignes suivantes et les decouper aussi, en inserant a chaque fois une ligne pour decaler le texte qui suis sur la ligne suivante, je ne sais pas si j'ai ete assez clair.
merci cris

Mercatog
le code que tu m'a donne, coupe toute la phrase, a chaque mot.
merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub Test()
Dim depart As Integer
Dim texte As String
Dim nouvellePhrase As String
 
   MsgBox "Découpe une phrase en chaines de 90 caractères maxi" _
   & Chr(13) & "sans couper les mots"
    depart = 24
    texte = [B23]
 
    Do While Len(texte) >= 90
        nouvellePhrase = Left(texte, 90)
        nouvellePhrase = InStrRev(nouvellePhrase, " ")
        Cells(depart, 1) = Left(texte, nouvellePhrase - 1)
        texte = Mid(texte, nouvellePhrase + 1)
        depart = depart + 1
    Loop
 
    Cells(depart, 1) = texte
 End Sub

[mercatog]

Bonsoir
Oui bien sûr, j'avais omis de préciser que la variable Nb doit comporter le nombre max de lettres (J'avais mis 1 pour tester les extrêmes)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Test()
Dim Mot As String, Txt As String
Dim i As Integer, j As Integer, Nb As Integer
Dim Tb
 
Nb = 90                                                              'Nb de lettres max par ligne
j = 24                                                               'Ligne de début de collage du résultat
Application.ScreenUpdating = False
With Sheets("Feuil3")                                                'A adapter
    Mot = .Range("B23").Value
    Tb = Split(Mot)
    Do
        Do While Len(Txt) <= Nb And i <= UBound(Tb)
            Txt = Txt & " " & Tb(i)
            i = i + 1
        Loop
        If .Range("B" & j).Value <> "" Then .Rows(j).Insert
        .Range("B" & j).Value = Trim(Txt)
        j = j + 1
        Txt = ""
    Loop Until i >= UBound(Tb)
End With
End Sub

[EDIT]
J'ai édité le code initial pour pallier à une petite coquille

[chris09300]

bonsoir mercatog
le code bug a
j = j + 1
il tourne sans cesse, je suis obliger de faire plusieurs fois esc, pr arreter le code.
cris