Discussion :

[Fmas09]

Bonjour,
j'aurai besoin de votre aide pour 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 (visible à l'écran) 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. Cette feuille PDF est enregistré 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 par la macro dont le titre est indéterminé.

en vous remerciant par avance pour votre aide

[Philippe Tulliez]

Bonjour,

quelle ligne me faudrait il ajouter dans ma macro afin de fermer automatiquement les nouveaux classeurs ouvert par la macro dont le titre est indéterminé.

Exemple pour le classeur actif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Close SaveChanges:=False

[mercatog]

Bonjour

Ferme le dernier fichier ouvert

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Workbooks.Count > 1 Then Workbooks(Workbooks.Count).Close False

Si le dernier ouvert est fermé manuellement, l'avant dernier sera fermé.

Le mieux est d'utiliser une variable

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub test()
Dim Wb As Workbook
 
Set Wb = Workbooks.Add 'ou set Wb=workbooks.open(chemin du fichier)
Wb.Sheets(1).Cells(1, 1) = 5
 
Wb.Close False
End Sub

[Fmas09]

Bonjour,


Exemple pour le classeur actif

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveWorkbook.Close SaveChanges:=False

Bonjour Philippe,
ci dessous la macro complète en sachant que c'est une compilation d'anciennes macro et que je suis nul en VBA et TRES NUL en anglais.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
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 ne souhaiterai pas que le classeur X1 s'enregistre dans le dossier mais en plus pouvoir le fermer.

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...

[Fmas09]

Bonjour Philippe et Mercatog,

MERCI mais j'ai essayé vos différentes propositions et je n'y arrive pas.

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):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
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

en vous remerciant pour votre aide
Bon dimanche

[mercatog]

Tu l'as sauvegardé d'abord en ligne 97 et tu dis vouloir le fermer sans sauvegarde

[Philippe Tulliez]

Bonjour Mercatog,
J'avoue que par moment, on a envie de se taper la tête contre un mur

En plus dans le titre de la discussion

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

à tel point que je me suis posé la question de la pertinence de remplir un classeur si ce n'était pas pour le sauver.

[Fmas09]

Re,
NUL en anglais et débutant en macro, je me suis servi d'ancienne macros pour en faire une compilation pour cette nouvelle macro.

dans un ancien classeur, j'avais un macro, qui ouvrait un nouveau classeur, faisait la mise en page, insérer les logo, ... , enregistré ce nouveau tableau (que j'avais besoin en excel pour d'autres modifications) et ouvrait un document PDF pour l'adresser à plusieurs personnes.

aujourd'hui, je ai besoin de ce 2 classeur que pour faire l'édition des lignes que j'ai uniquement besoin (une dizaine sur les X lignes de mon classeur), faire la mise en page, insert des logos et pied de page et cléer la feuille PDF. je n'ai donc plus besoin du classeur qui a servi à faire le PDF.

peut on faire autrement ?

[Fmas09]

Mercatog & Philippe,

Re,
je viens de supprimer les lignes 86 à 90 et la ligne 99. le nouveau classeur n'est pas enregistré mais il ne se ferme pas.

en sachant que la dernière fenètre ouverte et le document en PDF, comment faire pour fermer le classeur excel (celui crée par la macro).

ENCORE MERCI POUR VOTRE AIDE

[mercatog]

Personnellement, je crée une feuille que je mets en page une fois pour toute (genre une template).

J'utilise cette feuille comme support d'export en pdf

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub TEST()
 
Application.ScreenUpdating = False
With Worksheets("Tmp")
    Worksheets("SOURCE").Range("A1:G630").Copy .Range("C10")
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="Chemin complet du pdf.pdf"
End With
End Sub

La pagesetup étant trop gourmande en temps d'exécution

[Fmas09]

ok mercatog, je fais essayé.

avec cette solution, je vais pouvoir exporter que les ligne que je souhaite et qui change chaque fois?

Cordialement

[mercatog]

La feuille Tmp étant préparée au préalable (marges, entête, pied de page, largeur colonnes...)

Tu y copie les lignes à partir de la feuille source et tu exporte la feuille Tmp en pdf

[Fmas09]

Merci Mercatog,

j'ai fait les modifications que tu m'as indiqué et c'est impeccable, c'est juste ce que je souhaité et en plus avec un gain de temps.

il me reste un dernier problème que je n'arrive pas à solutionné, c'est comment, à l'enregistrement du PDF, ajouter la date et l'heure puisque je dois garder tous les PDF.

la ligne actuelle est:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép.PDF"

et je souhaiterai :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép_yyyy-mm-dd-hhmmss.PDF"

en te remerciant vivement et dans l'attente

Cordialement

[patricktoulon]

Bonjour
remplace

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép.PDF"

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép_" & format(now(),"yyyy-mm-dd-hhnnss")&".PDF"

[Fmas09]

Désolé,

dernière question (je pense) est il possible d'ouvrir le fichier pdf qui vient de s'enregistre automatiquement afin de pouvoir l'imprimer ou l'envoyer par mail (en sachant que l’imprimante ou le mail peut être différent.

en te remerciant beaucoup pour ton aide.


Cordialement


(vaut mieux un qui sait que dix qui cherchent longtemps!!)

[patricktoulon]

OUVERTURE DE N IMPORTE QUEL FICHIER

methode version 1: avec FollowHyperlink
Attention !!!! excite quand même un message d'avertissement de securité office

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
'FONCTION D'OUVERTURE FICHIER
Function OuvertureDeFichier1(fname)
    ThisWorkbook.FollowHyperlink fname
    End Function
'
Sub TestOuverture1()
    fname$ = "C:\Users\polux\DeskTop\getsystemmetrics.pdf"
    OuvertureDeFichier1 fname
End Sub

methode 2:avec Shell.Application"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Function OuvertureDeFichier2(fname)    'Version 2 avec shell.application
    Dim MonApplication As Object
    Set MonApplication = CreateObject("Shell.Application")
    MonApplication.Open (fname)
    Set MonApplication = Nothing
    ' n'exite  pas un message d'avertissement de securité office et est plus rapide
End Function
'
Sub TestOuverture2()
    fname$ = "C:\Users\polux\DeskTop\getsystemmetrics.pdf"
    OuvertureDeFichier2 fname
End Sub

IMPRIMER N IMPORTE QUEL FICHIER

methode 1:avec Shell.application

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function ImpressionDeFichier1(fname)    'Version 1 avec shell.application
    CreateObject("Shell.Application").Namespace(0).ParseName(fname).InvokeVerb ("Print")
End Function'
Sub TestImpressionDeFichier1()
' va Imprimer le fichier sur l'inprimante par defaut de WINDOWS!!!!!!!!!!!
    fname$ = "C:\Users\polux\DeskTop\getsystemmetrics.pdf"
    ImpressionDeFichier1 fname
End Sub

methode 2:avec wscript.shell( a revoir le concat du nom et l'ordre"print" dans les parenthèses)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function ImpressionDeFichier2(fname)    'Version 2 avec wscript.shell
    Dim WshShell, oExec
    Set WshShell = CreateObject("WScript.Shell")
    Set oExec = WshShell.Exec("Print  " & fname)    ' ne fonctionne pas je sais pas pourquoi??????
End Function
'
Sub TestImpressionDeFichier2()
' !!!!!!!!!!!!!!!va Imprimer le fichier sur l'inprimante par defaut de WINDOWS Pas celle par défaut dans excel !!!!!!!!!!!
    fname$ = "C:\Users\polux\DeskTop\getsystemmetrics.pdf"
    ImpressionDeFichier2 fname
End Sub

methode 3: avec l'api shellexecute
une adaptation de l'api en 64 bits sera peut être nécessaire pour les office en 64
Attention Imprime le fichier avec l'imprimante par defaut de excel pas celle de windows!!!!!!!!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                                      (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
                                    , ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
 
 
 
'avec utilisation de l'api shellexecute
   Function ImpressionDeFichier3(fname)
    Dim NomFichier As String
    'Recherche le fichier
    x = Application.hWnd
    'Imprime le fichier
    ShellExecute x, "print", fname, "", "", 1
End Function
Sub TestImpressionDeFichier3()
' va Imprimer le fichier sur l'inprimante par defaut de WINDOWS!!!!!!!!!!!
    fname$ = "C:\Users\polux\DeskTop\getsystemmetrics.pdf"
    ImpressionDeFichier3 fname
End Sub

[mercatog]

Bonjour Patrick

Simplement pour ouvrir le fichier pdf juste après export en pdf

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép_" & Format(Now(), "yyyy-mm-dd-hhnnss.p\df"), OpenAfterPublish:=True

[Fmas09]

Merci à vous deux pour cette aide.

derniers problèmes qui remontent en modifiant la macro d'origine:

dans le nom du fichier à enregistrer je souhaiterai ajouter la référence du dossier qui se trouve se trouve en C1O de la feuille "ProjDécomp", cela devrait donner :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Filename:="C:\Users\Fred \ESSAI ENREG\ProjDép_ REFERENCE" & Format(Now(), "yyyy-mm-dd-hhnnss") & ".PDF"  , OpenAfterPublish:=True

la 2° chose, est il possible de ne copier que le résultat d'une cellule et pas la formule?

Enfin dans la copie du fichier, je ne veux transférer que les lignes qui ont dans la colonne A des "1" dans la feuille ProjetDécomp est j'ai ce message qui remonte: vous ne pouvez exécuter cette commende sur la feuille protégé,. Comment la "déprotéger et la re protéger. j'ai essai d’inclure une macro par enregistrement mais je ne sais ou la mettre.

ci dessous la formule actuelle!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Macro1()
'
' EnregisterProjetDecompte
 
    Range("J1").Select
 
 
Application.ScreenUpdating = False
With Worksheets("ProjDécomp")
    Worksheets("Projet Décompte").Range("A1:G630").Copy .Range("A1")
 
 ' Select enreg avec code<>0
    ActiveSheet.Range("$A$5:$A$630").AutoFilter Field:=1, Criteria1:="1", _
    Operator:=xlAnd
 
 
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred\ESSAI ENREG\ProjDép_" & Format(Now(), "yyyy-mm-dd-hhnnss") & ".PDF" _
    , OpenAfterPublish:=True
 
End With
 
 
 
  '
End Sub

désolé, cela sort peut être de l'intitulé du message de départ mais je me bas avec cette macro depuis plus de 3 semaines et .....

en vous remerciant pour votre aide.

[mercatog]

Balise tes code sur le forum (bouton #)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim REF as string
'....
REF = Worksheets("ProjDécomp").Range("C10").Value
 '....
.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\Fred\ESSAI ENREG\ProjDép_" & REF & "_" & Format(Now(), "yyyy-mm-dd-hhnnss.p\df"), OpenAfterPublish:=True

[Fmas09]

MERCI Mercatog, Patrick et Philippe pour ton aide.

j'ai ENFIN réussi avec votre aide.

voici la macro qui clôture mes demandes. Pour mémoire, mon projet était de
* sélectionné quelques lignes (une dizaines sur plus de 600) du classeur (A),
* les copier dans une feuille B dont la mise en page, entête et pied de page avait préparer à l'avance,
* transformer cette feuille B en fichier PDF afin de l'imprimer et la transmettre par mail en PJ.
* remettre à zéro, la feuille A.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub EnregisterProjetDecompte()
'
 
' EnregisterProjetDecompte
    Range("J1").Select
 
' Copie les données
    Application.ScreenUpdating = False
With Worksheets("ProjDécomp")
    Worksheets("Projet Décompte").Range("A1:G630").Copy .Range("A1")
End With
 
' Select enreg avec code<>0
With Worksheets("ProjDécomp")
    Sheets("ProjDécomp").Select
    ActiveSheet.Range("$A$5:$A$630").AutoFilter Field:=1, Criteria1:="1", _
    Operator:=xlAnd
 
' Enregistre le fichier en mode PDF
    Dim REF As String
    REF = Worksheets("ProjDécomp").Range("C10").Value
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\EMPLACEMENT DU FICHIER A SAUVEGARDER \ProjDép_" & REF & "_" & Format(Now(), "yyyy-mm-dd-hhnnss.PDF"), _
    OpenAfterPublish:=True
    Sheets("Projet Décompte").Select
End With
 
' Efface les données en Projet Décompte
    Range("C10,E16:E607,E610").Select
    Range("E610").Activate
    Selection.ClearContents
    Range("C10").Select
 
End Sub

MERCI POUR VOTRE AIDE.
Cordialement