Option Explicit
Sub Ajuster()
Dim c As Range
For Each c In Columns(2).SpecialCells(xlCellTypeConstants)
If Len(c) > 85 Then
With c
.RowHeight = 37
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
End With
End If
Next
End Sub
Je regrette et dnne ma langue au chat : j'ai, pourtant, testé le code avant de le proposer......le pblm persiste tjrs????...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column <> 2 Then Exit Sub 'colonne B
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With TextBox1
.Visible = False
.AutoSize = False
.Font.Name = ActiveCell.Font.Name
.Font.Size = ActiveCell.Font.Size
.Width = 5000
.Value = ActiveCell
.AutoSize = True
End With
ActiveCell.UnMerge
While ActiveCell.MergeArea.Width < TextBox1.Width
Range(ActiveCell, ActiveCell.Offset(, 1)).Merge
Wend
ActiveCell.MergeArea.Select
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If ActiveCell.Column <> 2 Then Exit Sub 'colonne B
Dim marge#
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With TextBox1
.Visible = False
.AutoSize = False
.Font.Name = ActiveCell.Font.Name
.Font.Size = ActiveCell.Font.Size
TextBox1 = ""
.AutoSize = True
marge = TextBox1.Width - 1 'on conserve une petite marge de 1 point
.AutoSize = False
.Width = 5000
.Value = ActiveCell
.AutoSize = True
End With
ActiveCell.UnMerge
While ActiveCell.MergeArea.Width < TextBox1.Width - marge
Range(ActiveCell, ActiveCell.Offset(, 1)).Merge
Wend
ActiveCell.MergeArea.Select
End Sub
Fichier (2).
A+