Sub Impressiondevis()
Dim style As Integer
Application.ScreenUpdating = False
msg = "Voulez-vous convertir l'étude de prix en devis client ?"
style = vbYesNo + vbQuestion + vbDefaultButton1
title = "Impression Devis"
Response = MsgBox(msg, style, title)
If Response = vbYes Then
'Détection du début et fin du récapitulatif
Dim w As Object
Set w = Range("A1:A99999").Find("drecap")
Dim x As Integer
x = w.Row
Dim y As Object
Set y = Range("A1:A99999").Find("frecap")
Dim z As Integer
z = y.Row
Dim calcultotaux As Variant 'création d'une variable pour enregistrer les formules des totaux
Dim designation As Variant
Dim Image As Object
calcultotaux = Range(Cells(1, 11), Cells(z, 11)).Formula 'désignation de la zone de la variable à copier
designation = Range(Cells(x + 1, 2), Cells(z - 1, 2)).Formula
Set Image = ActiveSheet.Shapes(1) 'copie du logo
Image.Copy
ActiveSheet.Range(Cells(1, 1), Cells(z, 11)).Copy 'copie les données de la page active
Workbooks.Add 'création d'un nouveau classeur
With Sheets("Feuil1").Range("A1").End(xlUp)
.PasteSpecial Paste:=xlPasteValues 'copie des valeurs
.PasteSpecial Paste:=xlPasteFormats 'copie des formats
.PasteSpecial Paste:=xlPasteColumnWidths 'copie des largeurs de colonnes
.Application.CutCopyMode = False
End With
Range(Cells(1, 11), Cells(z, 11)).Value = calcultotaux
Range(Cells(x + 1, 2), Cells(z - 1, 2)).Value = designation
Columns("E:I").Delete Shift:=xlToLeft 'supprime les colonnes E à I
Rows("1:2").Delete Shift:=xlToUp
Dim c As Range, fml$
Application.ScreenUpdating = False
For Each c In ActiveSheet.Range(Cells(x - 2, 6), Cells(z - 4, 6))
fml = Replace(c.FormulaLocal, ";11;", ";6;")
c.FormulaLocal = fml
Next c
'Insert image
Worksheets(ActiveSheet.Index + 1).Activate
ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
'mise en page :
ActiveSheet.PageSetup.PrintTitleRows = "$6:$6"
Application.ScreenUpdating = False
DerLig = [A10000].End(xlUp).Row
DerCol = [Xfd1].End(xlToLeft).Column
Tableau = Cells(1, 1).Address & ":" & Cells(DerLig, DerCol).Address
Range(Tableau).Select
ActiveSheet.PageSetup.PrintArea = Tableau
ActiveWindow.View = xlPageBreakPreview
NbPage = ActiveSheet.HPageBreaks.Count + 1
ActiveWindow.View = xlNormalView
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "Impression du &D à &T"
.CenterFooter = ""
.RightFooter = "&P / &N"
.LeftMargin = Application.InchesToPoints(0.3)
.RightMargin = Application.InchesToPoints(0.1)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = NbPage
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
ActiveWindow.View = xlPageBreakPreview 'affichage en mode saut de page
ActiveWindow.Zoom = 100 'affichage zoom à 100%
End If
End Sub