XL 2016 Ajuster les lignes au Contenu

[KTM]

Bonjour chers tous
Jai une plage de données "A4:K2000"
La largeur de chaque colonnes est déjà fixée.
La hauteur des lignes est fixé à 45,1.
Je voudrais à laide d'une macro VBA ajuster les lignes au contenu si le texte déborde sinon maintenir les 45,1.
Jai élaboré un code mais il fonctionne pas comme je le souhaite.
Besoin d'aide....

Sub DimLigne()
Dim col As Range
Dim x As Long
x = 45.1
Application.ScreenUpdating = False
With ActiveSheet
For Each col In .Range("A4:K" & .Range("B" & Rows.Count).End(xlUp).Row + 1)
col.EntireRow.AutoFit
If col.RowHeight < x Then col.RowHeight = x
Next
End With
End Sub

 

[fanch55]

Bonjour,
Testez le code ci-dessous :

Sub DimLigne()
Const x = 45.1
Application.ScreenUpdating = False
    With ActiveSheet.Range("A4:K" & ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1)
        .Rows.AutoFit
        .WrapText = True
       'Il n'est pas utile de parcourir chaque cellule
        For Each Line In .Rows
            If Line.RowHeight < x Then Line.RowHeight = x
        Next
    End With
End Sub

 

[piga25]

Bonjour,
Un essai avec cela

Sub HauteurLigneAuto()
    Dim I As Long
    Selection.Rows.AutoFit
    For I = 4 To 2000
        If Selection.Rows(I).RowHeight < 45,1 Then Selection.Rows(I).RowHeight = 45,1
    Next I
    Range("A1").Select
End Sub

Attention s'il y a un texte long dans une colonne après la colonne K, cela ajustera également la hauteur de ligne.

 

[KTM]

Bonjour,
Testez le code ci-dessous :

Sub DimLigne()
Const x = 45.1
Application.ScreenUpdating = False
    With ActiveSheet.Range("A4:K" & ActiveSheet.Range("B" & ActiveSheet.Rows.Count).End(xlUp).Row + 1)
        .Rows.AutoFit
        .WrapText = True
       'Il n'est pas utile de parcourir chaque cellule
        For Each Line In .Rows
            If Line.RowHeight < x Then Line.RowHeight = x
        Next
    End With
End Sub

ok merci

 

[KTM]

Bonjour,
Un essai avec cela

Sub HauteurLigneAuto()
    Dim I As Long
    Selection.Rows.AutoFit
    For I = 4 To 2000
        If Selection.Rows(I).RowHeight < 45,1 Then Selection.Rows(I).RowHeight = 45,1
    Next I
    Range("A1").Select
End Sub

Attention s'il y a un texte long dans une colonne après la colonne K, cela ajustera également la hauteur de ligne.

Merci...