Bonjour les sauveurs,
J'espère que vous allez tous bien et que que vos familles sont en bonne santé.
Je reviens vers vous pour vous demander de l'aide sur une macro.
Voila, j'utilise dans une feuille Excel (offre proforma) une macro d'ajustement de la hauteur ce qui permet de distribuer les lignes de tel sorte qu'elles soient reparti sur une page A4.
Hors aujourd'hui je souhaite ajouter une en-tête et un pied de page a cette feuille de calcul.
J'ai mis en pièce jointe le modèle de l'offre et en fait ce que je souhaite avoir c'est: s'il y a plusieurs page, que les zone en jaune (dans le modèle, se répète au début et a la fin de toutes les pages sans inclure la dernière. la dernière page ce sont des conditions d'achat qui n'ont pas besoin d'avoir un pied de page ou une en-tête sauf le numéro, mais ca j'ai déjà fait).
Je vous remercie pour votre aide vraiment précieuse.
Voici le code de l'Autofit:
J'espère que vous allez tous bien et que que vos familles sont en bonne santé.
Je reviens vers vous pour vous demander de l'aide sur une macro.
Voila, j'utilise dans une feuille Excel (offre proforma) une macro d'ajustement de la hauteur ce qui permet de distribuer les lignes de tel sorte qu'elles soient reparti sur une page A4.
Hors aujourd'hui je souhaite ajouter une en-tête et un pied de page a cette feuille de calcul.
J'ai mis en pièce jointe le modèle de l'offre et en fait ce que je souhaite avoir c'est: s'il y a plusieurs page, que les zone en jaune (dans le modèle, se répète au début et a la fin de toutes les pages sans inclure la dernière. la dernière page ce sont des conditions d'achat qui n'ont pas besoin d'avoir un pied de page ou une en-tête sauf le numéro, mais ca j'ai déjà fait).
Je vous remercie pour votre aide vraiment précieuse.
Voici le code de l'Autofit:
VB:
Sub AutoFitMergedCellRowHeight()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = True
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
Sub AutoFit()
Max_Page_Height = 1500
Foot_Lenght = 270
Set Design_RANGE = Worksheets("PROFORMA").Range("D26:D1515")
Set Items_Range = Worksheets("Cost Sheet A&D").Range("B8:B1508")
Page_height = 0
For i = 1 To 25
Page_height = Page_height + Worksheets("PROFORMA").Cells(i, 1).RowHeight
Next
Design_RANGE.Cells(1, 1).Select
Call AutoFitMergedCellRowHeight
Page_height = Page_height + Design_RANGE.Cells(1, 1).RowHeight
Design_RANGE.Cells(2, 1).Select
Call AutoFitMergedCellRowHeight
Page_height = Page_height + Design_RANGE.Cells(2, 1).RowHeight
For i = 3 To 315
If Items_Range.Cells(i, 1) = "" Then
If (Max_Page_Height - (Page_height - Design_RANGE.Cells(i - 1, 1).RowHeight) - Foot_Lenght) < 0 Then
Design_RANGE.Cells(i - 2, 1).RowHeight = Max_Page_Height - (Page_height - Design_RANGE.Cells(i - 1, 1).RowHeight - Design_RANGE.Cells(i - 2, 1).RowHeight)
Else
If (Max_Page_Height - (Page_height - Design_RANGE.Cells(i - 1, 1).RowHeight) - Foot_Lenght) < 1500 Then
Design_RANGE.Cells(i - 1, 1).RowHeight = Max_Page_Height - (Page_height - Design_RANGE.Cells(i - 1, 1).RowHeight) - Foot_Lenght
Else
'Design_RANGE.Cells(i - 1, 1).RowHeight = 409
Rest = Max_Page_Height - (Page_height) - Foot_Lenght
While Rest > 0
Rows(25 + i).Select
Rows(Selection.Row - 1).Copy
Selection.Insert Shift:=xlDown
If Rest > 1500 Then
Design_RANGE.Cells(i, 1).RowHeight = 1500
Else
Design_RANGE.Cells(i, 1).RowHeight = Rest
End If
Rest = Rest - 1500
i = i + 1
Wend
End If
End If
Exit For
End If
Rows(25 + i).Select
Rows(Selection.Row - 1).Copy
Selection.Insert Shift:=xlDown
Design_RANGE.Cells(i, 1).RowHeight = 10
Design_RANGE.Cells(i, 1).Select
Call AutoFitMergedCellRowHeight
Page_height = Page_height + Design_RANGE.Cells(i, 1).RowHeight
If Page_height > Max_Page_Height Then
Design_RANGE.Cells(i - 1, 1).RowHeight = Max_Page_Height - (Page_height - Design_RANGE.Cells(i, 1).RowHeight - Design_RANGE.Cells(i - 1, 1).RowHeight)
Page_height = Design_RANGE.Cells(i, 1).RowHeight
End If
Next
End Sub