Comment fermer un classeur créé par une macro sans l'enregistrer

FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention   -  
FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
j'aurai besoin de votre aide modifier une macro qui se trouve dans le classeur "A".

cette macro effectue les choses suivantes:
  • Copie la feuille 1 du classer A puis
  • ouvre une nouvelle feuille dans un nouveau classeur dont le titre change au fur et à mesure de l'activation de la macro (Classeur1, puis classeur2, .... )
  • sélectionne les lignes à imprimer et fait la mise en page, ajoute les les pieds de page, logo, ...
  • Transforme la feuille du nouveau classeur (N°??) en format PDF, l'enregistre dans le dossier déterminé et ouvre le document à l'écran.

quelle ligne me faudrait il ajouter dans ma macro afin de fermer automatiquement les nouveaux classeurs ouvert dans le nom est indéterminé.
en vous remerciant par avance pour votre aide

4 réponses

  1.
    Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 784
     
    Bonjour

    Il faut :
    - Déclarer une variable classeur (par exemple Dim wbk As Workbook)
    - Y affecter le nouveau classeur créé (Set wbk = ...)
    - et fermer le classeur (wbk.Close)

    0
  2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour,

    ou bien, comme le dernier classeur créé est l'actif : 
    ActiveWorkbook.close

    eric
    0
  3. FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention  
     

    Sub EnregisterProjetDecompte2() 
    ' 
    ' EnregisterProjetDecompte 
    Calculate 
    Range("A1:G630").Select 
    Selection.Copy 

    Dim Emplacement As String 
    Emplacement = Cells(10, 3) 
    Workbooks.Add 
    Selection.PasteSpecial Paste:=xlPasteValues 
    Selection.PasteSpecial Paste:=xlPasteFormats 
    Selection.PasteSpecial Paste:=xlPasteColumnWidths 

    ' largeur colonne' 
    Columns("A:A").ColumnWidth = 0 
    Columns("B:B").ColumnWidth = 10 
    Columns("C:C").ColumnWidth = 48 
    Columns("D").ColumnWidth = 5 
    Columns("E:E").ColumnWidth = 7 
    Columns("F:F").ColumnWidth = 10 
    Columns("G:G").ColumnWidth = 12 

    ' HAUTEUR des lignes 
    Rows.AutoFit 

    ' Select enreg avec code<>0 
    ActiveSheet.Range("$A$5:$A$630").AutoFilter Field:=1, Criteria1:="1", _ 
    Operator:=xlAnd 

    ' mise en page MARGES ' 
    With ActiveSheet.PageSetup 
    End With 
    ActiveSheet.PageSetup.PrintArea = "" 
    With ActiveSheet.PageSetup 
    .LeftMargin = Application.InchesToPoints(0.196850393700787) 
    .RightMargin = Application.InchesToPoints(0.196850393700787) 
    .TopMargin = Application.InchesToPoints(0.9) 
    .BottomMargin = Application.InchesToPoints(0.590551181102362) 
    .HeaderMargin = Application.InchesToPoints(0.196850393700787) 
    .FooterMargin = Application.InchesToPoints(0.393700787401575) 
    .PrintHeadings = False 
    .PrintGridlines = False 
    .PrintComments = xlPrintNoComments 
    .CenterHorizontally = True 
    .Orientation = xlPortrait 
    .Draft = False 
    .PaperSize = xlPaperA4 
    .FirstPageNumber = xlAutomatic 
    .Order = xlDownThenOver 
    .BlackAndWhite = False 
    .Zoom = 100 
    .PrintErrors = xlPrintErrorsDisplayed 
    .OddAndEvenPagesHeaderFooter = False 
    .DifferentFirstPageHeaderFooter = False 
    .ScaleWithDocHeaderFooter = True 
    .AlignMarginsHeaderFooter = True 
    End With 
    ' fin de mise en page marges ' 

    ' Mise en page en portrait avec date impression et n° page ; le tout dans 1 seule page avec logo' 
    ActiveSheet.PageSetup.PrintArea = "$A$1:$G$630" 
    With ActiveSheet.PageSetup 
    .LeftHeaderPicture.Filename = _ 
    "C:\Users\NOM DU FICHIER.JPG" 
    .RightHeader = "Page &P de &N" 
    .LeftHeader = "&G" 
    .Orientation = xlPortrait 
    .LeftFooter = "adresse Socièté" 
    .CenterFooterPicture.Filename = _ 
    "C:\Users\LOGO.jpg" 
    .CenterFooter = "&G" 
    .Zoom = False 
    .FitToPagesWide = 1 
    .FitToPagesTall = 1 
    End With 

    '----------Enregistrement sous nom de fichier à sauvegarder ------------ 
    If Emplacement <> "" Then 

    ' désignation emplacement des fichiers sauvegardés ' 
    ChDir "C:\Users\NOM DU DOSSIER" ' 
    Application.DisplayAlerts = False 

    ' création fichier XLS ' 
    fichier = Emplacement & "_" & Format(Now, "yyyy-mm-dd-hhmmss") 
    nomFichier = "X1" & ".xls" 
    ActiveWorkbook.SaveAs Filename:=nomFichier, _ 
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ 
    ReadOnlyRecommended:=False, CreateBackup:=False 

    ' création fichier PDF' 
    fichier = Emplacement & "_" & Format(Now, "yyyy-mm-dd-hhmmss") 
    nomFichier2 = "Projet_" & fichier & ".pdf" 
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichier2, _ 
    Quality:=xlQualityStandard, OpenAfterPublish:=True 

    ' Fermeture tableau excel ... mais il est quand meme enregistré ' 
    Workbooks(X1.xls).Close SaveChanges:=False 
    Else 
    Answer = MsgBox(Prompt:=" Le nom du fichier n'est pas spécifié (Cellule C10), l'enregistrement n'est pas fait.", Buttons:=vbYes) 
    End If 

    ' EffaceProjetDécompte 
    ActiveWindow.SmallScroll Down:=6 
    Range("C10,E15:E606,E609").Select 
    Range("E609").Activate 
    Selection.ClearContents 
    ActiveWindow.ScrollRow = 1 
    Range("C10").Select 
    End Sub
    0
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Bonjour,

      tu as l'icone <> pour garder l'indentation et la présentation du code.
      Là c'est dur pour les yeux... 

      Dim wb As Workbook
'...
Set wb=Workbooks.Add
'...
wb.close

      comme disait Patrice ne fonctionne pas ?
      eric
      0
  4. FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention  
     
    Re
    à la demande d'Eric, j'essaie l'icone <>, ...

    je mets la macro originale (pour mémoire, je souhaite si c'est possible que le nouveau classeur -X1- ne s'enregistre pas et qu'il se ferme après l'ouverture de la page PDF): 

    Sub EnregisterProjetDecompte2()
    '
    '   EnregisterProjetDecompte
            Calculate
            Range("A1:G630").Select
            Selection.Copy
     
            Dim Emplacement As String
            Emplacement = Cells(10, 3)
            Workbooks.Add
            Selection.PasteSpecial Paste:=xlPasteValues
            Selection.PasteSpecial Paste:=xlPasteFormats
            Selection.PasteSpecial Paste:=xlPasteColumnWidths
     
    '   largeur colonne'
            Columns("A:A").ColumnWidth = 0
            Columns("B:B").ColumnWidth = 10
            Columns("C:C").ColumnWidth = 48
            Columns("D:D").ColumnWidth = 5
            Columns("E:E").ColumnWidth = 7
            Columns("F:F").ColumnWidth = 10
            Columns("G:G").ColumnWidth = 12
     
    '   HAUTEUR des lignes
            Rows.AutoFit
     
    '   Select enreg avec code<>0
            ActiveSheet.Range("$A$5:$A$630").AutoFilter Field:=1, Criteria1:="1", _
            Operator:=xlAnd
     
    '   mise en page MARGES '
        With ActiveSheet.PageSetup
        End With
            ActiveSheet.PageSetup.PrintArea = ""
        With ActiveSheet.PageSetup
            .LeftMargin = Application.InchesToPoints(0.196850393700787)
            .RightMargin = Application.InchesToPoints(0.196850393700787)
            .TopMargin = Application.InchesToPoints(0.9)
            .BottomMargin = Application.InchesToPoints(0.590551181102362)
            .HeaderMargin = Application.InchesToPoints(0.196850393700787)
            .FooterMargin = Application.InchesToPoints(0.393700787401575)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = True
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = 100
            .PrintErrors = xlPrintErrorsDisplayed
            .OddAndEvenPagesHeaderFooter = False
            .DifferentFirstPageHeaderFooter = False
            .ScaleWithDocHeaderFooter = True
            .AlignMarginsHeaderFooter = True
        End With
    '   fin de mise en page marges '
     
    '   Mise en page en portrait  avec date impression et n° page ; le tout dans 1 seule page avec logo'
            ActiveSheet.PageSetup.PrintArea = "$A$1:$G$630"
        With ActiveSheet.PageSetup
            .LeftHeaderPicture.Filename = _
            "C:\Users\NOM DU FICHIER.JPG"
            .RightHeader = "Page &P de &N"
            .LeftHeader = "&G"
            .Orientation = xlPortrait
            .LeftFooter = "adresse Socièté"
            .CenterFooterPicture.Filename = _
            "C:\Users\LOGO.jpg"
            .CenterFooter = "&G"
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
     
        '----------Enregistrement sous nom de fichier à sauvegarder ------------
        If Emplacement <> "" Then
     
    '   désignation emplacement des fichiers sauvegardés '
            ChDir "C:\Users\NOM DU DOSSIER" '
            Application.DisplayAlerts = False
     
    '   création fichier XLS '
            fichier = Emplacement & "_" & Format(Now, "yyyy-mm-dd-hhmmss")
            nomFichier = "X1" & ".xls"
           ActiveWorkbook.SaveAs Filename:=nomFichier, _
            FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
     
    '   création fichier PDF'
            fichier = Emplacement & "_" & Format(Now, "yyyy-mm-dd-hhmmss")
            nomFichier2 = "Projet_" & fichier & ".pdf"
            ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nomFichier2, _
            Quality:=xlQualityStandard, OpenAfterPublish:=True
     
    '   Fermeture tableau excel ... mais il est quand meme enregistré '
            Workbooks(X1.xls).Close SaveChanges:=False
        Else
            Answer = MsgBox(Prompt:=" Le nom du fichier n'est pas spécifié (Cellule C10), l'enregistrement n'est pas fait.", Buttons:=vbYes)
        End If
     
    '   EffaceProjetDécompte
            ActiveWindow.SmallScroll Down:=6
            Range("C10,E15:E606,E609").Select
            Range("E609").Activate
            Selection.ClearContents
            ActiveWindow.ScrollRow = 1
            Range("C10").Select
        End Sub


    donc, si possible, je souhaiterai que le classeur X1 ne s'enregistre pas dans le dossier mais en plus pouvoir le fermer automatiquement.

    merci pour votre aide
    PS : la macro "rame" peut être du à des ligne qui n'ont pas lieu d'être ou qui font tourner le programme en boucle surtout dans la mise en page. si vous pouviez améliorer...
    0
    1. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Perso je ne vois aucun essai d'une proposition ou de l'autre.
      Et il faut indenter ton code. Ca te permet de voir certaines erreurs (pas forcément ici). Tu devrais installer l'addin SmartIndent

      Edit : en plus tu postes sur plusieurs forums, j'abandonne donc ici.
      0
      1. FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention   > eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention  
         
        MERCI tout de même, et désolé pour le post sur plusieurs forum mais le délai pour finir ma macro arrive a échéance mercredi.
        0