Ajustement hauteur de ligne au contenu

Bonjour,

j'ai un code pour la gestion de l'ajustement de la hauteur de ligne par rapport au retour à la ligne via le bouton entrée (donc en forçant le retour à la ligne)

j'aimerai un code permettant de gérer et le retour à la ligne simple tout en gardant le retour à la ligne de manière forcer

voici le code que j'utilise :

Sub AR_hauteur_ligne()

Dim tbl As Variant
Dim lastRow As Long, lastCol As Long
Dim A As Integer
Dim I As Long, J As Long
Dim dblCounter As Double

    Application.ScreenUpdating = False

With Sheets("AR")

    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row

    lastCol = .Cells(26, Columns.Count).End(xlToLeft).Column

    For I = 26 To lastRow

    dblCounter = 0

    For J = 2 To lastCol

    If Not IsEmpty(Cells(I, J)) Then

    tbl = Split(Cells(I, J).Value, Chr(10))

    dblCounter = UBound(tbl) + 1

    If (20 * dblCounter) > .Rows(I).RowHeight Then

    .Rows(I).RowHeight = 20 * dblCounter

    c = dblCounter - 1

    For z = 1 To c

    If .Rows(I).RowHeight <> 20 Then

    supp = lastRow + 1

    If .Rows(supp).RowHeight = 45 Then

    Set CEL = .Range("A" & supp - 15 & ":L" & supp).Find("*Titre*", LookIn:=xlValues, lookat:=xlWhole)

    If .Range("B" & CEL.Row + 3) Like "*Périmètre*" Then

    Sheets("ModAR").Rows("1:24").Copy
    .Rows(supp + 1).Insert Shift:=xlDown
    .Rows(supp - 1).Copy .Rows(supp + 5)
    .Rows(supp - 1).Delete

    Else

    Sheets("ModAR").Rows("25:48").Copy
    .Rows(supp + 1).Insert Shift:=xlDown
    .Rows(supp - 1).Copy .Rows(supp + 5)
    .Rows(supp - 1).Delete

    If .Rows(supp + 4).RowHeight <> 20 Then

    x = .Rows(supp + 4).RowHeight / 20
    For y = 1 To x

    .Rows(supp + 6).Delete

    Next y

    .Rows(supp).PageBreak = xlPageBreakManual

    lastRow = .Cells(Rows.Count, 2).End(xlUp).Row

    lastCol = .Cells(25, Columns.Count).End(xlToLeft).Column

    I = I + 5

    End If
    End If
    Else

    .Rows(supp).Delete

    End If
    End If
    Next z
    End If
    End If
    Next J
    Next I
End With
End Sub

Merci de votre aide

Mika

Rechercher des sujets similaires à "ajustement hauteur ligne contenu"