Discussion :

[GADENSEB]

Bonjour le Forum,

Je cherche ajuster la hauteur des cellules remplies de texte.

A chaque fois, il y a sept colonnes fusionnées
J'ai bricolé cela mais rien de concret ...

J'ai du oublier un truc ....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim a, nbrligne As Integer
Sub MiseEnForme()
'On définit le nombre de lignes réellement utilisées
Feuil1.Select
nbrligne = Feuil1.Range("A65536").End(xlUp).Row
'Puis on les parcourt
For a = 1 To nbrligne
'Pour chaque ligne on parcourt les sept premières colonnes
For b = 1 To 7
'Ici on renvoie le texte à la ligne
If Feuil1.Cells(a, b).Value <> "" Then
      Feuil1.Cells(a, b).Select
      Selection.WrapText = True
End If
Next b
Next a
End Sub

[Invité]

bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
With ActiveSheet.UsedRange
    .ColumnWidth = 200
    .Cells.EntireRow.AutoFit
    .Cells.EntireColumn.AutoFit
 End With
End Sub

[GADENSEB]

Hello Rudupt,

heuuuuu avec ton code came fait agrandir en longeur les cellules
C'est rigolo mais bof ....lol

[Invité]

le problème c'est que les lignes ne peuvent pas ce réduire si le texte fait des retour ligne!

mais au moins ça marche?

[GADENSEB]

Oui ca marche.
Je comprends le pb du retour à la ligne.
Du coup, serait-ce possible de forcer le retour à la retour à la ligne ?

[eriiic]

Bonjour,

Et pourquoi pas une seule colonne de 560 pixels ?
Sur cet exemple la fusion ne sert à rien.

Sinon une proposition avec une feuille intermédiaire tmp ayant la colonne A à 560 pixels :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub hauteur()
    Dim lig As Long, lig2 As Long
    Dim h As Long, pl As Range
    For lig = 11 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(lig, 1).MergeCells Then
            With Sheets("tmp").[A1]
                .Value = Cells(lig, 1).Value
                .Font.Name = Cells(lig, 1).Font.Name
                .Font.Size = Cells(lig, 1).Font.Size
                .Font.FontStyle = Cells(lig, 1).Font.FontStyle
                .EntireRow.AutoFit
                h = .Height
            End With
            Set pl = Cells(lig, 1).MergeArea
            For lig2 = 1 To pl.Rows.Count
                pl.Rows(lig2).RowHeight = h / pl.Rows.Count
            Next lig2
            lig = lig + pl.Rows.Count - 1
        End If
    Next lig
End Sub

Reste à voir les pb d'arrondi pour les fusions multi-lignes (à cumuler sur 1 ligne ?), plus les approximations d'excel qui met une première ligne vide parfois sur EntireRow.AutoFit.

PS: je n'ai pas tenu compte des fusions qui ne faisaient que 4 colonnes, non annoncé et vu ensuite.

eric