XL 2019 Hauteur de ligne vba

netparty · 9 Avril 2022

Bonjour à tous

Est-il possible en vba de changer la hauteur des lignes, je vous explique ce que je souhaite.
Je voudrais placer un bouton + et un bouton - quand je clique sur plus j'augmente la hauteur de la ligne de +10 et quand je clique sur - je diminue ma ligne de -10.

Merci d'avance

Bonne journée

sylvanu · 9 Avril 2022

Bonjour Netparty,
Un ex pour augmenter ou diminuer toutes les lignes :

VB:

Sub PlusHaut()
    Cells.RowHeight = Cells.RowHeight + 10
End Sub
Sub PlusBas()
    Cells.RowHeight = Cells.RowHeight - 10
End Sub

A adapter si cela ne concerne que quelques lignes.

sylvanu · 9 Avril 2022

Bonjour Netparty,
Un ex pour augmenter ou diminuer toutes les lignes :

VB:

Sub PlusHaut()
    Cells.RowHeight = Cells.RowHeight + 10
End Sub
Sub PlusBas()
    Cells.RowHeight = Cells.RowHeight - 10
End Sub

A adapter si cela ne concerne que quelques lignes.

netparty · 9 Avril 2022

sylvanu à dit:
Bonjour Netparty,
Un ex pour augmenter ou diminuer toutes les lignes :

VB:

Sub PlusHaut() Cells.RowHeight = Cells.RowHeight + 10 End Sub Sub PlusBas() Cells.RowHeight = Cells.RowHeight - 10 End Sub

A adapter si cela ne concerne que quelques lignes.

Bonjour @sylvanu

Merci c'est top

mapomme · 9 Avril 2022

Bonjour @netparty , @sylnanu

Un autre code qui tient compte des limites des hauteurs de lignes. On limite la hauteur entre 0 (cachée) et 409 pour ne pas provoquer d'erreur.

Il suffit de sélectionner des cellules (une ou plusieurs) dans les lignes concernées par la modification de la hauteur des lignes puis de cliquer sur un des bouton "flèche".
La modif se fait sur toutes les lignes dont des cellules sont sélectionnées.

Le code est dans module2:

VB:

Sub Rectangle1_Cliquer()
   PlusOuMoins 10
End Sub

Sub Rectangle5_Cliquer()
   PlusOuMoins -10
End Sub

Sub PlusOuMoins(ByVal deltaH)
Dim x, h
   With ActiveSheet
      For Each x In Intersect(.Rows, Selection.EntireRow).Rows
         h = x.RowHeight + deltaH
         If h < 0 Then h = 0
         If h > 409 Then h = 409
         x.RowHeight = h
      Next x
   End With
End Sub

sylvanu · 9 Avril 2022

Bonjour Mapomme,
Il y a peut être plus simple dans ce cas :

VB:

Sub PlusHaut()
    Cells.RowHeight = Application.Min(Cells.RowHeight + 10, 409)
End Sub
Sub PlusBas()
    Cells.RowHeight = Application.Max(Cells.RowHeight - 10, 0)
End Sub

Juste pour le plaisir de polémiquer.

Bernard_XLD · 9 Avril 2022

Bonjour Netparty, sylvanu, mapomme, le forum

Si c'est juste pour le plaisir de polémiquer, alors, pour gérer les lignes masquées !

Bien cordialement, @+

VB:

Sub PlusHaut()
    If Cells.RowHeight > 0 Then With Cells.SpecialCells(xlCellTypeVisible): .RowHeight = Application.Min(.RowHeight + 10, 409): End With Else Cells.RowHeight = 10
End Sub
Sub PlusBas()
    With Cells.SpecialCells(xlCellTypeVisible): .RowHeight = Application.Max(.RowHeight - 10, 0): End With
End Sub

mapomme · 9 Avril 2022

sylvanu à dit:
Juste pour le plaisir de polémiquer.

Plus rapide de rester en VBA que de repasser par Excel. Mais c'est juste pour polémiquer en ce samedi matin veille d'élection.

Mais si vous voulez du concis en VBA:

VB:

Sub PlusOuMoins(ByVal deltaH)
Dim x
For Each x In Intersect(Rows, Selection.EntireRow).Rows: x.RowHeight = IIf(x.RowHeight + deltaH < 0, 0, IIf(x.RowHeight + deltaH > 409, 409, x.RowHeight + deltaH)): Next x
End Sub

Et ça répond à la question posée et lève la séance des polémiques, ah ben dis donc !

Décidément Ils ont tous décidé de me gâcher cette matinée ensoleillée, même le modo s'y met!

Bonjour @Bernard_XLD

netparty · 9 Avril 2022

mapomme à dit:
Bonjour @netparty , @sylnanu

Un autre code qui tient compte des limites des hauteurs de lignes. On limite la hauteur entre 0 (cachée) et 409 pour ne pas provoquer d'erreur.

Il suffit de sélectionner des cellules (une ou plusieurs) dans les lignes concernées par la modification de la hauteur des lignes puis de cliquer sur un des bouton "flèche".
La modif se fait sur toutes les lignes dont des cellules sont sélectionnées.

Le code est dans module2:

VB:

Sub Rectangle1_Cliquer() PlusOuMoins 10 End Sub Sub Rectangle5_Cliquer() PlusOuMoins -10 End Sub Sub PlusOuMoins(ByVal deltaH) Dim x, h With ActiveSheet For Each x In Intersect(.Rows, Selection.EntireRow).Rows h = x.RowHeight + deltaH If h < 0 Then h = 0 If h > 409 Then h = 409 x.RowHeight = h Next x End With End Sub

bonjour @mapomme

Merci pour ton code

Bonne journée

XL 2019 Hauteur de ligne vba

netparty

XLDnaute Occasionnel

sylvanu

sylvanu

XLDnaute Barbatruc

netparty

XLDnaute Occasionnel

mapomme

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Bernard_XLD

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

netparty

XLDnaute Occasionnel

Discussions similaires