Ajuster la hauteur des lignes par VBA

Bonjour à tous,

Avec le code ci-dessous j'agrandis les lignes existantes de 8 points pour aérer un peu le texte d'une base de donnée car autofit est encore un peu sérré pour mon confort visuel.

Mon problème c'est que je souhaiterais que le balayage commence à partir de l'adresse que j'informe dans l'imputbox, et dans ce cas, il commence le balayage depuis la ligne 1 (alors que la BDD ne commence que plus bas dans la feuille)...
Je suis en train de m'enméler les pinceaux, et je ne vois pas ou est mon erreur.

Merci pour votre éclairage,

Très bonne journée.

emile

Sub CentrerTexteVerticalement()
'Après "Autofit" qui est un peu court, ajoute de la hauteur (paramétrable) en plus de celle qu'elle a,
'aux lignes du tableau afin d'aérer un peu le texte du tableau
Dim MaLettre, MonAdresse, i%, hauteur%, iRowHeight&, Rng As Range
hauteur = 8 ' Possibilité de jouer avec ce paramètre

 ActiveSheet.Select
'msg: départ de la base de donnée, titre non inclu.

  MonAdresse = InputBox("Adresse de la cellule où commence la recalibration de la BDD", "Agrandir les lignes de la BDD - ppt8", "J5", vbOKCancel + vbDefaultButton1 + vbExclamation)

    If MonAdresse <> "" Then
        MaLettre = Left(MonAdresse, 1)
        i = Range(MonAdresse).Row
        Set Rng = Range(MonAdresse, Cells(Rows.Count, MaLettre).End(xlUp))
        Rng.EntireRow.AutoFit

            For i = 1 To Rng.Count
                iRowHeight = Rows(i).RowHeight
                iRowHeight = iRowHeight + hauteur
                Rows(i).RowHeight = iRowHeight
            Next
    End If
End Sub

Bonsoir Émile, bonsoir le forum,

Peut-être comme ça :

Sub CentrerTexteVerticalement()
Dim MonAdresse As String
Dim PL As Long, DL As Long
Dim Hauteur As Integer

Hauteur = 8 ' Possibilité de jouer avec ce paramètre
MonAdresse = InputBox("Adresse de la cellule où commence la recalibration de la BDD", "Agrandir les lignes de la BDD - ppt8", "J5", vbOKCancel + vbDefaultButton1 + vbExclamation)
If MonAdresse <> "" Then
    PL = Range(MonAdresse).Row
    DL = Range(MonAdresse).CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
    Rows(PL & ":" & DL).RowHeight = Rows(PL).RowHeight + hauteur
End If
End Sub

Salut ThauThème,

Merci pour ton aide.
Le problème dans ce code c'est que chaque cellule de la zone sélectionnée à la même hauteur...
Alors que dans ma BDD il y a des cellules qui ont 2 - 3 - 4 -5 lignes, des fois plus, et du coup le centrage verticale uniforme ne fonctionne pas. :(
D'ou la boucle...

Je reste à l'écoute d'une variante s'il y a, et encore merci et bonne journée.

Bonjour à tous,
Toujours en standby avec mon soucis VBA, je me permets de relancer ma question au cas où quelqu'un aurait une solution pour moi.
Merci d'avance pour votre aide.
Emile

Bonjour,

sans doute qu'un fichier exemple montrant le avant/après des différents cas aiderai à motiver des réponses
eric

Bonjour eriiic,

Merci pour ta suggestion.
Voici en fichier joint un exemple de mon propos avec un code VBA inachevé, car non fonctionnel.

Merci d'avance pour ton aide et reste dans l'attente d'une prochaine solution.

Emile

Bonjour,

à tester :

Sub CentrerTexte()
    Const lig1 As Long = 9 ' 1ère ligne à ajuster
    'Après "Autofit" qui est un peu court, ajoute de la hauteur (paramétrable)en plus de celle qu'elle a,
    'aux lignes du tableau afin d'aérer un peu le texte du tableau
    Dim hauteur%, Rng As Range, i As Long
    hauteur = 8 ' Possibilité de jouer avec ce paramètre
    Set Rng = Cells(lig1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row - lig1 + 1, 3)
    Application.ScreenUpdating = False
    Rng.EntireRow.AutoFit
    For i = lig1 To Rng.Count - lig1 + 1
        Rows(i).RowHeight = Rows(i).RowHeight + hauteur
    Next
End Sub

c'est un probleme difficile a gérer, c'est pourquoi on utilise de préférence un font MONOSPACE comme "Courier"

Sub CentrerTexte()
     hauteur = 8     ' Possibilité de jouer avec ce paramètre

     With ActiveSheet
          .Columns("B").Font.Name = "Courier"     'MONOSPACE font !
          .Cells.VerticalAlignment = xlTop     'aligner en top (autrement difficile a voir les différences)
          With .Range("A9:A16,A20:A30,A40:A100")     'quelque ranges
               .EntireRow.AutoFit
               For Each c In .Cells
                    c.EntireRow.RowHeight = c.EntireRow.RowHeight + hauteur
               Next
          End With
     End With
End Sub