Private Sub Worksheet_Change(ByVal Target As Range) 'de job75
Dim r As Range, x$, n%, c As Range, t$, s, i&
If Target.Count = 1 Then
If Not Intersect(Target, [D41]) Is Nothing Then
Application.EnableEvents = False
Set r = Intersect(Target, [D41])
r.NumberFormat = "General"
For Each r In r 'si entrées multiples (copier-coller)
If r Like "#" Or r Like "##" Or r Like "###" Or r Like "####" Then
x = Format(r, "0000")
r = Left(x, 2) & ":" & Mid(x, 3)
r.NumberFormat = "hh:mm"
End If
Next
Application.EnableEvents = True
'Else
' Exit Sub
End If
If Not Intersect(Target, [B39:B41]) Is Nothing Then
n = 70 'nombre maximum de caractères par cellule, paramétrable
On Error Resume Next
'---1ère cellule à traiter---
Set r = Intersect(Target, [B39:B41]) 'la zone que j'ai adapté
'---concaténation des textes à partir de la 1ère cellule---
For Each c In r.Resize(Rows.Count - r.Row + 1).SpecialCells(xlCellTypeConstants)
t = t & " " & c
Next
On Error GoTo 0
If t = "" Then Exit Sub
'---analyse du texte---
t = Application.Trim(t) 'SUPPRESPACE
s = Split(t) 'tableau des mots
t = ""
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
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les événements
r.Resize(Rows.Count - r.Row + 1).ClearContents 'RAZ
s = Split(t, vbLf) 'tableau des paragraphes
For i = 0 To UBound(s)
r.Offset(i) = Trim(s(i)) 'un paragraphe par ligne
Next
Application.EnableEvents = True 'réactive les événements
Application.ScreenUpdating = True
End If
End If
End Sub
