Copier la zone d'impression dans nouveau classeur

[Mimi]

Bonjour à tous,
Voila sur mon fichier j'ai ce code :

Sub EnregistrerFacture()
Dim Obj As Object
Dim NomFichier As String

ActiveSheet.Copy
NomFichier = Range("J5")

For Each Obj In ActiveSheet.DrawingObjects
Obj.Delete
Next Obj

ActiveWorkbook.SaveAs Filename:="C:\Facture\Facture\" & "Fact-AV" & ActiveSheet.Range("H5").Value & " " & Format(Date, "d mmmm yyyy") & " " & NomFichier & ".xls"
ActiveWorkbook.Close

MsgBox "Sauvegarde effectuée . ", vbInformation, "Message"


Sheets("Inserer").Select

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False

End Sub
Le problème c'est que a l'enregistrement il m'enlève les boutons et le logo, or je voudrais enlevé que les boutons d'où le titre enregistrer que la zone d'impression.

D'avance Merci
Michel

 

[JCGL]

Re : Copier la zone d'impression dans nouveau classeur

Bonjour à tous,

Peux-tu essayer avec ;

Sub EnregistrerFacture()
    Dim Obj As Object
    Dim NomFichier As String

    ActiveSheet.Copy
    NomFichier = Range("J5")

    'For Each Obj In ActiveSheet.DrawingObjects
    'Obj.Delete
    'Next Obj
    ActiveSheet.Shapes("Picture 135").Delete

    ActiveWorkbook.SaveAs Filename:="C:\Facture\Facture\" & "Fact-AV" & ActiveSheet.Range("H5").Value & " " & Format(Date, "d mmmm yyyy") & " " & NomFichier & ".xls"

    ActiveWorkbook.Close
    MsgBox "Sauvegarde effectuée . ", vbInformation, "Message"
    Sheets("Inserer").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False
End Sub

A+ à tous

 

[Mimi]

Re : Copier la zone d'impression dans nouveau classeur

Bonjour JCGL,

Je te remercie pour ta réponse rapide, c'est ok nickel

Encore merci

Michel