ajustement de la hauteur d'une zone pour impression.

Re : ajustement de la hauteur d'une zone pour impression.

bonjour à tous,
Euréka !!! enfin j'espère !!
voici la macro permettant d'ajuster une zone donnée en diminuant ou augmentant la taille des lignes vides. pour toujours avoir la même hauteur de zone.
pour le moment ça a l'air de fonctionner.

Sub AjustementZone()
Dim i, HauteurTotaleLigne

Fact.Range("a18:f46").Rows.AutoFit
HauteurTotaleLigne = Fact.Range(Rows(18), Rows(46)).Height

If HauteurTotaleLigne > 415 Or HauteurTotaleLigne < 410 Then
For i = 46 To 18 Step -1

If Fact.Range(Rows(18), Rows(46)).Height < 410 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 20
If Fact.Range(Rows(18), Rows(46)).Height > 410 Then Exit For
End If
If Fact.Range(Rows(18), Rows(46)).Height > 415 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 2
If Fact.Range(Rows(18), Rows(46)).Height < 415 Then Exit For
End If

Next
End If

End Sub

merci pour votre participation, je vous tien au courant.

Re : ajustement de la hauteur d'une zone pour impression.

Re le forum,
il y à encore quelques imperfections, presque négligeable,
mais voici la dernière mouture :
Sub ajustement1()
Dim i, Hauteurtotaleligne, L
i = Fact.Range("L3").Value
If i > 45 Then GoTo 3
L = Fact.Range("B47").End(xlUp).Row + 1
If L > 19 Then
Fact.Range("a18:f46").Rows.AutoFit
Hauteurtotaleligne = Fact.Range(Rows(18), Rows(46)).Height

If Hauteurtotaleligne > 415 Or Hauteurtotaleligne < 410 Then
For i = Fact.Range("B47").End(xlUp).Row + 2 To 46 'To 18 Step -1

If Fact.Range(Rows(18), Rows(46)).Height < 410 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 20
If Fact.Range(Rows(18), Rows(46)).Height > 410 Then Exit For
End If
If Fact.Range(Rows(18), Rows(46)).Height > 415 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 2
Fact.Range("L3").Value = i
If Fact.Range(Rows(18), Rows(46)).Height < 415 Then Exit For
End If

Next
End If
End If

3 If i = 46 Then 'lorsque i dépasse 46 les lignes suivantes doivent être écrites dans le tableau du dessous.

L = Fact.Range("B113").End(xlUp).Row + 1

End If
End Sub

merci aux participant @ plus

Re : ajustement de la hauteur d'une zone pour impression.

Re

Debarquant du post precedent

A tester:

Re : ajustement de la hauteur d'une zone pour impression.

bonjour le forum,
bonjour pierrejean
votre macro est très intéressante de part sa simplicité, mais il me faut l'adapter car il m'est impossible de supprimer des lignes dans la zone A18:F46. (des cellules se trouvant en dessous de cette zone ne pouvant être déplacées.)
merci pour cette simplicification.
je vous tien au courant.

Re : ajustement de la hauteur d'une zone pour impression.

Re

Dans ce cas il est possible de remplacer

par

Re : ajustement de la hauteur d'une zone pour impression.

Re,
cher pierrejean,
cette petite amélioration éclaircie la partie écrite de ma zone.
cette proposition est intéressante, mais qu'entendez vous par:

'traiter ici le cas de la facture trop longue pour une feuille


et je vais me permettre de mettre la partie, nous intéressant,
de la longue macro qui fonctionne à peu près bien.

Private Sub CommandButton1_Click()
Dim i As Integer
Dim L As Long
Dim Ctrl As Control
Dim U As Range
Dim nFact, VarFacturier As String
Dim Réponse As String
Dim Quest, Request, AutreQuest, Remise, Hauteurtotaleligne
Fact.Activate
i = Fact.Range("L3").Value 'mémoire de la dernière ligne écrite.
If i > 45 Then GoTo 3
L = Fact.Range("B47").End(xlUp).Row + 1
'Fact.Range("B47").End(xlUp).Select
If L > 19 Then
'If L > 46 Then GoTo 3
Fact.Range("a18:f46").Rows.AutoFit
Hauteurtotaleligne = Fact.Range(Rows(18), Rows(46)).Height

If Hauteurtotaleligne > 415 Or Hauteurtotaleligne < 410 Then
For i = Fact.Range("B47").End(xlUp).Row + 2 To 46 'To 18 Step -1

If Fact.Range(Rows(18), Rows(46)).Height < 410 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 20
If Fact.Range(Rows(18), Rows(46)).Height > 410 Then Exit For
End If
If Fact.Range(Rows(18), Rows(46)).Height > 415 Then
If Fact.Range("B" & i) = "" Then Rows(i).RowHeight = 2
Fact.Range("L3").Value = i
If Fact.Range(Rows(18), Rows(46)).Height < 415 Then Exit For
End If

Next
End If
End If

3 If i = 46 Then

L = Fact.Range("B113").End(xlUp).Row + 1

End If

'suite de la macro

je continu sur votre proposition,
je vous tien au courant.