ajustement de la hauteur d'une zone pour impression.

[Macpoy]

bonjour le forum,
auriez vous la gentillesse de m'aider à compléter ce bout de macro svp.

Sub ajustement()

Fact.Range("a18:f60").Rows.AutoFit

End Sub

le but étant que dans tous les cas, avec ou sans texte, cette zone est une hauteur de 366.

c'est un imprimé que je rempli grâce à un USF et qui vous le comprendrais doit tenir sur une page A4. les lignes de 18 à 60 étant la seule zone sur laquelle je peu agir pour faire la mise en page avant impression.
pour le moment je le fait en manuel, mais bon!!!

merci d'avance

 

[Macpoy]

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.

 

[Macpoy]

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

 

[pierrejean]

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

Re

Debarquant du post precedent

A tester:

Sub test()
x = Range("B17").End(xlDown).Row
nbl = x - 17
limite = Range("A11").RowHeight
If 366 / nbl < limite Then
  'traiter ici le cas de la facture trop longue pour une feuille
Else
For n = 46 To x + 1 Step -1
  Rows(n).Delete
Next n
End If
htot = Range("A18:A" & x).Height
For n = 18 To x
  Rows(n).RowHeight = Rows(n).RowHeight * 366 / htot
Next n
End Sub

 

[Macpoy]

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.

 

[pierrejean]

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

Re

Dans ce cas il est possible de remplacer

For n = 46 To x + 1 Step -1
  Rows(n).Delete
Next n

par

For n = 46 To x + 1 Step -1
  Rows(n).RowHeight=valeur minimum admissible
Next n

 

[Macpoy]

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.