Ajuster la hauteur d'une plage de lignes

Résolu
samoushka Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -  
samoushka Messages postés 2 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour tout le monde,

Je voudrais creer un code VBA qui puisse ajuster la hauteur de mes lignes en fonction du nombre de caracteres que des cellules contiennent.

J'ai reussi a trouver la logique pour une cellule.... Maintenant j'ai toujours ete nulle pour ecrire des boucles.

Voici le code pour une cellule :

Sub AutofitRow8()
'Select the row
Rows("8").Select
'Define the default height and set the row at 15
Rows("8").RowHeight = 15
DefHeight = Rows("8").RowHeight

'Define the nb of characters
NbCha = Len(Range("E8"))

'Define the new height
' For a default height of 15 and for this column width, there are about 35 characters
Multiple = NbCha / 35

'Round the multiple 2 decimals higher so the new height fits properly
'(Number + 0.1) -> higher decimal
'10 ^ 1 -> rounded to 1 decimal
MultipleRounded = Int((Multiple + 0.1) * 10 ^ 1 + 1) / 10 ^ 1
'New height is obtbained by multiplying the defHeight by the multiple rounded

NewHeight = DefHeight * MultipleRounded

'Set the new height
Rows("8").RowHeight = Application.Max(15, NewHeight)
End Sub

Ce que je voudrais maintenant, c'est que le code parcoure les lignes 7, 8 et 9 et reajuste la taille de ces lignes, en considerant le nombre de caracteres des cellules de la colonne E.
autre option : que le code s'applique aux lignes que j'ai selectionnees.

J'espere avoir ete claire dans mes propos... J'ai vraiment besoin de cette macro car je perds un temps monstre a reformater les cellules pour mes rapports.

Merci beaucoup d'avance

PS : j'ecris avec un clavier qwerty donc desolee pour les accents...

2 réponses

eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

la macro s'applique à la sélection.
Sub autofitSel()
    Dim c As Range
    For Each c In Selection.Columns(1).Cells
        AutofitRow c
    Next c
End Sub

Sub AutofitRow(c As Range)
    'Define the default height and set the row at 15
    c.RowHeight = 15
    DefHeight = c.RowHeight

    'Define the nb of characters
    NbCha = Len(c)

    'Define the new height
    ' For a default height of 15 and for this column width, there are about 35 characters
    Multiple = NbCha / 35

    'Round the multiple 2 decimals higher so the new height fits properly
    '(Number + 0.1) -> higher decimal
    '10 ^ 1 -> rounded to 1 decimal
    MultipleRounded = Int((Multiple + 0.1) * 10 ^ 1 + 1) / 10 ^ 1
    'New height is obtbained by multiplying the defHeight by the multiple rounded

    NewHeight = DefHeight * MultipleRounded

    'Set the new height
    c.RowHeight = Application.Max(15, NewHeight)
End Sub 

à tester

eric
1
samoushka Messages postés 2 Date d'inscription   Statut Membre Dernière intervention  
 
Je viens de tester, le code marche a merveille.

Merci beaucoup Eric !
0