Ajustement Texte multilignes dans Cellule

[viscere]

Bonjour,


Je récupère un champs String à l'aide d'un text box multilignes (Possibilité d'appuyer sur entrée dans le textbox).

En l'insérant dans une cellule je souhaiterais que le format de cette dernière s'ajuste automatiquement à la taille du texte.

J'ai essayé de fusionner plusieurs cellule avant d'insérer mon texte, ca marche pour la longueur mais pas pour la hauteur.

J'ai essayé la fonction AutoFit rien n'y fait la hauteur de la cellule me montre qu'une seule ligne.

Merci,

Laurent

 

[viscere]

Re : Ajustement Texte multilignes dans Cellule

bon j'ai trouvé ca. Ca marche nikel

'Ajuste la hauteur de la cellule en fonction du nombre de lignes dans la cellule
 
Sub AutoFitMergedCellRowHeight()
 
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
 
 If ActiveCell.MergeCells Then
   With ActiveCell.MergeArea
     .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
     If .Rows.Count = 1 Then 'And .WrapText = True Then
       Application.ScreenUpdating = True
       CurrentRowHeight = .RowHeight
       ActiveCellWidth = ActiveCell.ColumnWidth
       For Each CurrCell In Selection
           MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
       Next
      .MergeCells = False
      .Cells(1).ColumnWidth = MergedCellRgWidth
      .EntireRow.AutoFit
       PossNewRowHeight = .RowHeight
      .Cells(1).ColumnWidth = ActiveCellWidth
      .MergeCells = True
      .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
     End If
   End With
 End If
 
End Sub