Ajuster automatiquement la hauteur des lignes
Bonjour,
J'utilise un classeur pour rentrer des codes dans une colonne et obtenir des libellés plus ou moins long dans une autre colonne.
je dois faire renter les tableaux obtenus qui peuvent être assez long dans une seule feuille A3 et j'ai besoin que mes hauteurs de lignes soient réduites au minimum.
Pour ajuster automatiquement la hauteur des lignes dans la colonne des libellés, j'utilise la macro suivante :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Rows(Target.Row).AutoFit
End Sub
Peut-on avec la commande "Rows(Target.Row).AutoFit" définir que cet ajustement doit se faire selon un multiple de la hauteur de la ligne de départ ?
Je m'explique : j'utilise pour mes tableaux :
Police : Arial
Taille : 8
Pour un gain de place , Hauteur de ligne : 11,25
Lors de la saisie d'une cellule l'"AutoFit " me transforme automatiquement la Hauteur de la ligne en 13,5 pour un texte court (d'une ligne), en 23,25 pour un texte plus long ((de 2 lignes), alors que le texte est entièrement visible avec une hauteur de 2 x 11,25 = 22,50
Autre inconvénient, lorsque la hauteur de ligne a été modifiée par l'"AutoFit " impossible de revenir en arrière automatiquement à une hauteur de 11,25, avec un texte court.
Si bien que je dois redimensionner manuellement la dimension de mes tableaux avant leur impression et que la macro ne me sert à rien.
Merci d'avance pour vos réponses
Bonjour,
Lorsque je fais un ajustement automatique avec une police Arial de taille 8, j'obtiens une hauteur de ligne de 11,25 avec un texte court et 22,5 pour un texte de 2 lignes.
As-tu vérifié que ta ligne ne contient pas de cellules ayant une autre police et une autre taille ?
A+
Bonjour,
Avec ton code et une police Arial 8 pour la feuille entière. mes lignes font bien 11,25, puis 2*11,25, 3*11,25, etc...
Cdlt.
Bonsoir,
Merci à tous les 2 pour vos réponses.
J'ai bien réglé pour toute la feuille, la taille de la police Arial à 8.
Lorsque je saisi un code dans une cellule, la hauteur de ligne passe maintenant à :
- 12 pour un libellé court.
- 23,25 pour un libellé s'inscrivant sur 2 lignes.
- 45,75 pour un libellé s'inscrivant sur 3 lignes.
Merci encore pour votre aide.
bonjour a vous
je ne sais pas si le code que je te propose correspond a ton souhait, mais lorsque j'ajoute une prestation sur mon devis, si la ligne a écrire est plus longue que la cellule, l'inscription règle automatiquement la hauteur
With .Range("D" & lig)
.Font.Size = 14
.Font.Name = "arial"
.MergeCells = False
.WrapText = True 'retour du texte à la ligne
.EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
.MergeCells = True 'refusionner
'.VerticalAlignment = xlCenter
.RowHeight = IIf(MaHauteur > 15, MaHauteur, 15) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
End Withsans oublier les variables
Dim lig As Integer,MaHauteur As Singleet la valeur de "lig"
lig = .Range("B65536").End(xlUp)(2).Row
If lig < 19 Then lig = 19il faut une valeur dans la colonne B pour fonctionner et l'inscription démarre a ligne 19
Pascal
Bonjour,
J'ai recopié tel quel le code dans l'éditeur :
Dim lig As Integer, MaHauteur As Single
lig = .Range("B65536").End(xlUp)(2).Row
If lig < 19 Then lig = 19
With .Range("D" & lig)
.Font.Size = 14
.Font.Name = "arial"
.MergeCells = False
.WrapText = True 'retour du texte à la ligne
.EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
.MergeCells = True 'refusionner
'.VerticalAlignment = xlCenter
.RowHeight = IIf(MaHauteur > 15, MaHauteur, 15) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
End With
Mais j'obtiens le massage d'erreur suivant :
"Erreur de compilation :
Instruction incorrecte à l'intérieur d'une procédure" pour :
"(2)" de "End(xlUp)(2).Row"
Cette procédure s'applique-t-elle bien à la colonne "D" à partir de la ligne "19" ?
Tu dis :
"il faut une valeur dans la colonne B pour fonctionner et l'inscription démarre a ligne 19".
Alors la cellule "B65536" sert-elle de limite ?
Moi, je saisie des références (code personnel) dans un tableau : "M9:P38" et mes libellé s'inscrivent automatiquement dans la colonne" V" à partir de la cellule "V9"
Merci pour tes explications.
Bonjour,
J'ai recopié tel quel le code dans l'éditeur :
Dim lig As Integer, MaHauteur As Single
lig = .Range("B65536").End(xlUp)(2).Row
If lig < 19 Then lig = 19
With .Range("D" & lig)
.Font.Size = 14
.Font.Name = "arial"
.MergeCells = False
.WrapText = True 'retour du texte à la ligne
.EntireRow.AutoFit 'mettre la ligne en ajustement auto de la hauteur
MaHauteur = .RowHeight 'voir quelle est la hauteur de la ligne une fois cet autofit fait
.MergeCells = True 'refusionner
'.VerticalAlignment = xlCenter
.RowHeight = IIf(MaHauteur > 15, MaHauteur, 15) 'si la hauteur une fois autofit fait est inferieur à 15 je laisse 15 en minimum sinon hauteur de l'autofit (perso c'est la hauteur mini que je voulais
End With
Mais j'obtiens le massage d'erreur suivant :
"Erreur de compilation :
Instruction incorrecte à l'intérieur d'une procédure" pour :
"(2)" de "End(xlUp)(2).Row"
Cette procédure s'applique-t-elle bien à la colonne "D" à partir de la ligne "19" ?
Tu dis :
"il faut une valeur dans la colonne B pour fonctionner et l'inscription démarre a ligne 19".
Alors la cellule "B65536" sert-elle de limite ?
Moi, je saisie des références (code personnel) dans un tableau : "M9:P38" et mes libellé s'inscrivent automatiquement dans la colonne" V" à partir de la cellule "V9"
Merci pour tes explications.
bonsoir pat 38
j'ai pensé que ça te semblerai évident que la 1ère ligne commençant avec "with.range......" t'aurais mis sur la voie, bon il faut que tu rajoute avant "lig="
with sheets("Feuil1")au le nom de ta feuille et en fin de code
end withjoint un fichier exemple pour mieux comprendre avec des données bidons
perso je serai pas la demain et mercredi mais surement que Jean-Eric saura t'aider
Pascal
Re-bonjour,
Encore merci pour vos conseils à tous, en particulier ceux de Pascal, à qui je m'adresse directement.
Je joins le "Fichier_bidon que tu m'as demandé". C'est un fichier exemple (je ne suis pas cafetier, bien sur).
Avec le code :
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Rows(Target.Row).AutoFit
End Sub
Il fonctionne, mais comme je l'avais indiqué précédemment, bien que la hauteur des cellules de la feuille soit au départ à 11,25, elle passe à
- 12 pour un libellé court.
- 23,25 pour un libellé s'inscrivant sur 2 lignes.
- 45,75 pour un libellé s'inscrivant sur 3 lignes.
L'autre problème, c'est que ce code, ne fonctionne pas avec les cellules fusionnées (voir cellules V7 et Z7, une deuxième ligne existe mais reste cachée), même si après avoir copié les tableaux, en les collant dans Word, la deuxième ligne apparaît.
Je n'ai pas réussi à utiliser ton code. Il faut dire que je débute en VB et que je n'ai pas encore saisi toutes les subtilités de la syntaxe.
Si tu peux m'apporter de l'aide sans trop te casser la tête, je t'en remercie.
PB
Bonjour à tous,
Voilà, j'y suis arrivé avec ce code :
Private Sub Worksheet_Change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
Rows(target.Row).AutoFit
With Range("V7:X7,Z7:AB7")
.MergeCells = False
.Rows.AutoFit
DoEvents
Hauteur = Int(.RowHeight / 6.9)
.WrapText = True
.MergeCells = True
.RowHeight = Hauteur
.VerticalAlignment = xlVAlignCenter
End With
End Sub
Encore merci à tous.
Je joins le classeur modifié.
bonsoir Pat38
tu vois avec un zeste d'aide et beaucoup de persévérance ça réussi, maintenant il faut clore le post en cliquant sur le coche en haut du post a coté de éditer
Pascal
Bonjour,
J'ai réécrit ce code qui me convient mieux et qui fonctionne bien pour ajuster la hauteur des cellules de multiples de 11,25, selon la longueur du texte :
Private Sub Worksheet_Change(ByVal target As Range)
Dim nbcar As Integer
Application.ScreenUpdating = False
With Range("V7:X7")
nbcar = (Len(Range("V7"))) + (Len(Range("W7"))) + (Len(Range("X7")))
If nbcar < 60 Then
Rows(7).RowHeight = 11.25
ElseIf nbcar > 60 And ((nbcar / 60) - CInt(nbcar / 60)) > 0 Then
Rows(7).RowHeight = 11.25 * (CInt(nbcar / 60) + 1)
ElseIf nbcar > 60 And ((nbcar / 60) - CInt(nbcar / 60)) = 0 Then
Rows(7).RowHeight = 11.25 * (CInt(nbcar / 60))
Else
Rows(7).RowHeight = 11.25
End If
End With
With Range("W9" & lig)
nbcar = Len(Range("W9"))
If nbcar < 35 Then
Rows(9).RowHeight = 11.25
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) > 0 Then
Rows(9).RowHeight = 11.25 * (CInt(nbcar / 35) + 1)
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) <= 0 Then
Rows(9).RowHeight = 11.25 * (CInt(nbcar / 35))
Else
Rows(9).RowHeight = 11.25
End If
End With
Application.ScreenUpdating = True
End Sub
Je voudrais répéter sans le réécrire la deuxième partie de ce code :
With Range("W9" & lig)
nbcar = Len(Range("W9"))
If nbcar < 35 Then
Rows(9).RowHeight = 11.25
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) > 0 Then
Rows(9).RowHeight = 11.25 * (CInt(nbcar / 35) + 1)
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) <= 0 Then
Rows(9).RowHeight = 11.25 * (CInt(nbcar / 35))
Else
Rows(9).RowHeight = 11.25
End If
End With
de la cellule W9 à la cellule W38 ou mieux jusqu'à la dernière cellule non vide, au cas où je voudrais rallonger mon tableau vers le bas.
J'ai essayé le code suivant :
Dim drLig As Long
drLig = .Range("W" & Rows.Count).End(xlUp).Row
.Range("W9").AutoFill Destination:=.Range("W9:W" & drLig)
Mais il ne fonctionne pas (peut-être l'ai-je placé au mauvais endroit ?).
Quelqu'un pourrait-il m'aider.
Merci,
A toute fin utile voici mon classeur :
bonjour Pat38
deja enlève les points devant les 3 range car il demande quelquechose devant ou avec un "with"et toi tu ait référence a la feuille
peut tu mettre tes codes plus lisibles en cliquant sur code avant de coller ou en sélectionnant ton code et cliquer sur code
Pascal
Peux-tu directement regarder le code dans la feuille de calcul pour savoir ce que je dois faire pour le répéter de la ligne 9 (cellule W9) à la dernière ligne, sans avoir à le réécrire pour chaque cellule W10, W11, W... ?
Où dois-je insérer ? :
drLig = Range("W" & Rows.Count).End(xlUp).Row
Range("W9").AutoFill Destination:=Range("W9:W" & drLig)Faut-il que je désigne implicitement ma ligne de départ dans "W9" dans mon code ou plutôt "W?" ou quelque chose comme ça ?
Merci
Bonjour,
Voilà mon code est terminé, j'y suis arrivé enfin et tout seul. Il fonctionne très bien. Il fallait faire une boucle avec For, Next.
Excuses-moi pour mon ignorance, mais j'ai débuté avec VBA, il y a à peine une dizaine de jour.
Je livre mon code au cas où bien que je sois novice, il pourrait peut-être rendre service à quelqu'un.
En effet, je suis allé sur de nombreux forum et la question d'ajustement des lignes est souvent posées mais jamais parfaitement traitée et la façon simpliste dont j'ai raisonnée peut apparaître intéressante pour certains.
Donc voici le code en entier, il s'applique à une feuille de la ligne 7 jusqu'à la dernière ligne:
Private Sub Worksheet_Change(ByVal target As Range)
Dim nbcar As Integer, i As Integer, drLig As Long
Application.ScreenUpdating = False
With Range("V7:X7")
nbcar = (Len(Range("V7"))) + (Len(Range("W7"))) + (Len(Range("X7")))
If nbcar < 60 Then
Rows(7).RowHeight = 11.25
ElseIf nbcar > 60 And ((nbcar / 60) - CInt(nbcar / 60)) > 0 Then
Rows(7).RowHeight = 11.25 * (CInt(nbcar / 60) + 1)
ElseIf nbcar > 60 And ((nbcar / 60) - CInt(nbcar / 60)) <= 0 Then
Rows(7).RowHeight = 11.25 * (CInt(nbcar / 60))
Else
Rows(7).RowHeight = 11.25
End If
End With
For i = 9 To 10
nbcar = Len(Cells(i, 23))
If nbcar < 35 Then
Rows(i).RowHeight = 11.25
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) > 0 Then
Rows(i).RowHeight = 11.25 * (CInt(nbcar / 35) + 1)
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) <= 0 Then
Rows(i).RowHeight = 11.25 * (CInt(nbcar / 35))
Else
Rows(i).RowHeight = 11.25
End If
Next i
drLig = Range("W" & Rows.Count).End(xlUp).Row
For i = 11 To drLig
nbcar = Len(Cells(i, 23))
If nbcar < 35 Then
Rows(i).RowHeight = 11.25
ElseIf Cells(i, 23) = (" Total") Then
Rows(i).RowHeight = 11.25
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) > 0 Then
Rows(i).RowHeight = 11.25 * (CInt(nbcar / 35) + 1)
ElseIf nbcar > 35 And ((nbcar / 35) - CInt(nbcar / 35)) <= 0 Then
Rows(i).RowHeight = 11.25 * (CInt(nbcar / 35))
Else
Rows(i).RowHeight = 11.25
End If
Next i
Application.ScreenUpdating = True
End SubJe joins également mon fichier test :
Merci pour tout, à bientôt peut-être sur le forum.
PB