Supprimer un classeur en le fermant

[isa44]

Bonjour ,

Je créer un nouveau classeur pour pouvoir mettre en page une impression.
A la fin de l'impression ou si j'annule l'impression je voudrais supprimer le classeur créer :

Sub Classeur_impression()

           Application.ScreenUpdating = False
           
     Sheets("Signalements").Select ' Copie la feuille signalements
        ActiveSheet.Unprotect
    Range("D46:P113").Copy

    'Créer un nouveau classeur
    Workbooks.Add
    'Nommer la première feuille "test"
    Sheets(1).Name = "Impression"
    
    
        ' Colle la feuille signalements
      Range("D46").PasteSpecial

    ActiveWorkbook.SaveAs Filename:="CLASSEUR_IMPRESSION"

           ActiveWindow.DisplayGridlines = False ' Grille Excel invisible
               ActiveWindow.DisplayZeros = False ' n'affiche pas les valeurs zéro

           
           
    
    Range("H48:J53,K48:P60").Select
    With Selection.Font
        .Name = "Tahoma"
        .FontStyle = "Normal"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    
     Range("K48:P60").Font.Size = 10
    
    
    
    
    
    With Range("A63:P113")
      .FormatConditions.Delete
      .Borders.LineStyle = xlNone
    End With
 
    Columns("D:D").ColumnWidth = 4.71
    Columns("E:E").ColumnWidth = 6.43
    Columns("F:F").ColumnWidth = 35.29
    Columns("G:G").ColumnWidth = 9
    Range("H:J,O:O,M:M").ColumnWidth = 7
    Columns("K:K").ColumnWidth = 7.43
    Columns("L:L").ColumnWidth = 140 '101
'    Columns("M:M").ColumnWidth = 60 '7.71
    Columns("N:N").ColumnWidth = 90
    Columns("P:P").ColumnWidth = 90
    
    Range("K48:P60").Interior.ColorIndex = xlNone
    Range("H48:J53").Interior.ColorIndex = 40
    Range("H48:J53").Font.ColorIndex = 0
    Range("K48:P60").Font.ColorIndex = 0
    Range("D63:K113").Font.ColorIndex = 0
    Range("M63:P113").Font.ColorIndex = 0

        Rows("1:45").Select
    Selection.EntireRow.Hidden = True
    Columns("A:C").Select
    Selection.EntireColumn.Hidden = True


  For lig = 63 To 163

 
Range(Cells(lig, "D"), Cells(lig, "P")).Select
Selection.EntireRow.AutoFit ' hauteur ligne automatique
Selection.EntireRow.RowHeight = Selection.EntireRow.RowHeight + 10 ' + 10 pixel
If Selection.EntireRow.RowHeight < 50 Then Selection.EntireRow.RowHeight = 50 ' hauteur de ligne 25 mini
Next
  
    
         Range("N61").FormulaR1C1 = "Imprimé le :"
         Range("P61").FormulaR1C1 = "=NOW()"




' Nouvelles MFC (gris 1 sur 2 )

    Range("D63:P113").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=MOD(LIGNE();2)=0"
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.FormatConditions(1).Interior.ColorIndex = 15
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=MOD(LIGNE();1)=0"
    With Selection.FormatConditions(2).Borders(xlLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(2).Borders(xlRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(2).Borders(xlTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.FormatConditions(2).Borders(xlBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.FormatConditions(2).Interior.Pattern = xlNone




' Titres du tableau en haut du verso
        With ActiveSheet.PageSetup
            .PrintTitleRows = "$62:$62"
            .PrintTitleColumns = ""
        End With
        
        ' zone d'impression
     ActiveSheet.PageSetup.PrintArea = "$D$46:$P$113"
    
     
     
     
     ' marges
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.15748031496063)
        .RightMargin = Application.InchesToPoints(0.15748031496063)
        .TopMargin = Application.InchesToPoints(0.196850393700787)
        .BottomMargin = Application.InchesToPoints(0.196850393700787)
        .HeaderMargin = Application.InchesToPoints(0.078740157480315)
        .FooterMargin = Application.InchesToPoints(3.93700787401575E-02)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA3
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 2
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    
    Workbooks("CLASSEUR_IMPRESSION.xls").Close savechanges:=False
    

    Windows("PARC HIVER 2012 2013.6.xls").Activate
        

End Sub

Merci pour votre aide

 

[phlaurent55]

Re : Supprimer un classeur en le fermant

Bonjour Isa,

l'instruction "Kill" permet de supprimer un fichier

vois l'aide F1

à+
Philippe

 

[isa44]

Re : Supprimer un classeur en le fermant

Je tourne en bourique , je n'y arrive pas à écrire le code !!! A l'aide .....

 

[dionys0s]

Re : Supprimer un classeur en le fermant

Bonjour Isa, Bonjour Philippe

Code trouvé sur ce forum :

Sub Suicide()

Application.ScreenUpdating = False

    Dim objNB As Object
    Set objNB = Workbooks.Add
    With ThisWorkbook
        Open .Path & "\xx.bas" For Output As #1
        Print #1, "Sub Temp"
        Print #1, "Workbooks(" & """" & .Name & """" & ").Close False"
        Print #1, "Kill " & """" & .Path & "\" & .Name & """"
        Print #1, "Kill " & """" & .Path & "\xx.bas" & """"
        Print #1, "ThisWorkbook.Close False"
        Print #1, "End Sub"
        Close #1
    objNB.VBProject.VBComponents.Import Filename:=.Path & "\xx.bas"
    End With
    Application.OnTime Now(), objNB.Name & "!Temp"

End Sub

 

[dionys0s]

Re : Supprimer un classeur en le fermant

Isa consulte ce topic, tu devrais t'en sortir avec tout ça : https://www.excel-downloads.com/threads/vba-supprimer-un-classeur-a-sa-fermeture.153690/