XL 2019 Hauteur de ligne vba

[netparty]

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]

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

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]

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

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]

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:

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]

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

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]

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, @+

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]

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:

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]

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:

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