Bonjour,
Il y a quelques jours, j'ai ouvert une discussion concernant l'insertion d'un saut de ligne à chaque retour à la ligne automatique et j'ai fini par trouver une solution dans une ancienne discussion.
Ce code me permet de faire en sorte qu'en collant du texte dans la cellule B3, celui-ci soit automatiquement distribué sur des lignes de 45*caractères max. et qu'entre ces lignes soit inséré le caractère du saut de ligne, tout ça dans la même cellule B3. J'ai ensuite ajouté dans la cellule adjacente (C3) une formule qui remplace le caractère de saut de ligne par un gros carré noir. J'ai besoin de ça pour coller ensuite le résultat dans une autre application qui ne reconnaît malheureusement pas le caractère des sauts de ligne et dans laquelle je remplace manuellement les gros carrés par une balise interne au logiciel.
Ce que je souhaiterais obtenir, c'est qu'à la fin du code qui réorganise mon texte en B3, le contenu de ma cellule C3 soit copié dans le Presse-Papiers directement. Je ne sais pas si c'est possible, mais ce serait vraiment très pratique.
Je vous ai mis en pièce jointe mon fichier d'exemple et voici le code que j'utilise :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n%, P As Range, r As Range, s, i%, x$, t$
n = 45 'nombre maximum de caractères par ligne, paramétrable
Set P = Range("B3:B" & Rows.Count) 'à adapter
Set r = Intersect(Target, P, Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False = False
Application.EnableEvents = False 'désactive les événements
For Each r In r 'si entrées multiples (copier-coller)
s = Split(RTrim(Replace(r, vbLf, " "))) 'tableau des mots
For i = 0 To UBound(s)
x = t & IIf(i, " ", "") & Left(s(i), n)
t = t & vbLf & Left(s(i), n)
t = IIf(Len(x) - InStrRev(x, vbLf) > n, t, x)
Next
r = t
Next
'---ajustement des lignes et colonnes---
P.WrapText = False
P.RowHeight = 10
P.ColumnWidth = 70
P.WrapText = True
P.Rows.AutoFit
P.Columns.AutoFit
Application.EnableEvents = True 'réactive les événements
End Sub
Merci d'avance pour votre aide,
AL
Il y a quelques jours, j'ai ouvert une discussion concernant l'insertion d'un saut de ligne à chaque retour à la ligne automatique et j'ai fini par trouver une solution dans une ancienne discussion.
Ce code me permet de faire en sorte qu'en collant du texte dans la cellule B3, celui-ci soit automatiquement distribué sur des lignes de 45*caractères max. et qu'entre ces lignes soit inséré le caractère du saut de ligne, tout ça dans la même cellule B3. J'ai ensuite ajouté dans la cellule adjacente (C3) une formule qui remplace le caractère de saut de ligne par un gros carré noir. J'ai besoin de ça pour coller ensuite le résultat dans une autre application qui ne reconnaît malheureusement pas le caractère des sauts de ligne et dans laquelle je remplace manuellement les gros carrés par une balise interne au logiciel.
Ce que je souhaiterais obtenir, c'est qu'à la fin du code qui réorganise mon texte en B3, le contenu de ma cellule C3 soit copié dans le Presse-Papiers directement. Je ne sais pas si c'est possible, mais ce serait vraiment très pratique.
Je vous ai mis en pièce jointe mon fichier d'exemple et voici le code que j'utilise :
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n%, P As Range, r As Range, s, i%, x$, t$
n = 45 'nombre maximum de caractères par ligne, paramétrable
Set P = Range("B3:B" & Rows.Count) 'à adapter
Set r = Intersect(Target, P, Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False = False
Application.EnableEvents = False 'désactive les événements
For Each r In r 'si entrées multiples (copier-coller)
s = Split(RTrim(Replace(r, vbLf, " "))) 'tableau des mots
For i = 0 To UBound(s)
x = t & IIf(i, " ", "") & Left(s(i), n)
t = t & vbLf & Left(s(i), n)
t = IIf(Len(x) - InStrRev(x, vbLf) > n, t, x)
Next
r = t
Next
'---ajustement des lignes et colonnes---
P.WrapText = False
P.RowHeight = 10
P.ColumnWidth = 70
P.WrapText = True
P.Rows.AutoFit
P.Columns.AutoFit
Application.EnableEvents = True 'réactive les événements
End Sub
Merci d'avance pour votre aide,
AL
