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
| 'Pointer le bureau
Const Cible = &H10
'
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
'
'création d'un dossier nommé Extrait_Entité blabla
MkDir objFolderItem.Path & "\Extraits_" & Nom_Entite & "_" & Year(Date) & "_" & Month(Date) & "_" & Day(Date)
Application.DefaultFilePath = objFolderItem.Path & "\Extraits_" & Nom_Entite & "_" & Year(Date) & "_" & Month(Date) & "_" & Day(Date)
'
' faire une boucle pour imprimer toutes les plages à imprimer dans le dossier créé
Dim Plage_a_imprimer As Range
Dim NomFich As String
For Each Plage_a_imprimer In Range("data_extraits_impression_A")
Application.ActivePrinter = "Adobe PDF sur Ne02:"
NomFich = Nom_Entite & "_" & Plage_a_imprimer & ".pdf"
Application.Goto Reference:=Plage_a_imprimer.Value
' la ligne qui pose problème : les fichiers ne s'ouvrent pas en pdf et ne sont pas dans le dossier
' Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NomFich
' Selection.PrintOut Copies:=1, ActivePrinter:="Adobe PDF sur Ne02:", PrintToFile:=True, Collate:=True, PrToFilename:=NomFich
' la même ligne dépouillée amène à la saisie manuelle des noms de fichiers.pdf à loger dans le dossier prévu et parfaitement lisibles
' le dossier prévu ci-dessus n'est pas ouvert dans la fenêtre d'enregistrement du fichier imprimé en pdf
Selection.PrintOut Copies:=1, Collate:=True
Next Plage_a_imprimer |
Partager