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
A voir également:

4 réponses

Réponse 1 / 4
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
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
Réponse 2 / 4
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
Bonjour,

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

eric
0
Réponse 3 / 4
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
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
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
Réponse 4 / 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
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 276
 
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
FMas09600 Messages postés 26 Date d'inscription   Statut Membre Dernière intervention   > eriiic Messages postés 24603 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