Imprimer onglet Excel avec Microsoft Print to PDF

Bonjour à tous,

J'ai une macro qui sélectionne des onglets et qui imprime sur la dernière imprimante utilisée par l'utilisateur.

Voici la macro qui marche:

Sub abc()

Sheets(Array("1", "2", "3", "4", "C16", "RF1", "RF2")).Select

Sheets("1").Activate

ActiveWindow.SelectedSheets.PrintOut copies:=1, Collate:=True, _

IgnorePrintAreas:=False

MsgBox "Impression effectuée sur l'imprimante que vous aviez sélectionnée précédemment. Pour préserver nos forêts, nous vous recommandons l'impression en PDF en faisant: Fichier Imprimer, puis sélection de l'imprimante Microsoft Print to PDF, puis appuyer sur le bouton gris macro"

Sheets("Données").Select

End Sub

Je voudrais que l'impression se fasse sur l'imprimante: "Microsoft Print to PDF". Je ne peux pas sauver les fichiers car les chemins et habitudes sont propres à chaque utilisateur (disque local C: ou groupe G:, etc.). Le mieux est que le collaborateur choisisse à chaque macro sur quel disque il souhaite sauver son travail. Voilà pourquoi j'aimerais utiliser ce procédé d'imprimante PDF et pas de sauvegarde je ne sais où.

Ce qui ne marche pas (et je ne sais pas pourquoi):

Ajouter à la fonction ci-dessus cela:

Sub abc()

Application.ActivePrinter = "Microsoft Print To PDF"

End Sub

Merci d'avance pour votre aide et dites-vous qu'en plus d'aider quelqu'un, vous nous permettrez d'épargner la forêt.

Jacko

Bonjour Jacko,

à tester,

Sub test()
Dim oFolder As String, fName As String
Dim FD As FileDialog

Sheets(Array("1", "2", "3", "4", "C16", "RF1", "RF2")).Select
Sheets("1").Activate

Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.AllowMultiSelect = False
.Show
oFolder = .SelectedItems(1)
End With

fName = oFolder & "\Monfichier " & Now & ".pdf"

ChDir oFolder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub

Hello,

Merci pour la proposition mais elle ne marche pas encore. Quand je l'exécute, j'ai une fenêtre parcourir qui s'ouvre à l'exécution de la ligne

.Show

et qui me demande de saisir une information dans Nom de dossier:

Je choisis le dossier en appuyant sur ok et j'ai un message box de Microsoft VB:"Erreur d'excécution '2147024773 (8007007b)' Document non enregistré."

Merci pour votre aide.

Jacko80

Bonjour,

pouvez-vous essayer celle-ci, pour le choix du répertoire

Sub ChoixRepertoire()
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path

    MsgBox Chemin
End Sub

Bonjour,

La bonne nouvelle, c'est que la macro s'exécute. La mauvaise c'est que même en suivant le chemin indiqué dans la msgbox, je ne retrouve pas de trace du fichier qui aurait dû être enregistré.

J'ai une fenêtre "Browse for Folder" qui s'ouvre désormais. Je re-sélectionne le fichier de destination mais le document ne s'y trouve pas.

Sub abc()

Dim oFolder As String, fName As String
Dim FD As FileDialog

Sheets(Array("1", "2", "3", "4", "C16", "RF1", "RF2")).Select
Sheets("1").Activate

Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.AllowMultiSelect = False
.Show

Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim Chemin As String

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

    On Error Resume Next
    Set oFolderItem = objFolder.Items.Item
    Chemin = oFolderItem.Path

    MsgBox Chemin

oFolder = .SelectedItems(1)
End With

fName = oFolder & "\Monfichier " & Now & ".pdf"

ChDir oFolder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
Sheets("Données").Select
Range("A1").Select
End Sub

Bonjour,

pouvez-vous essayer comme ça,

Sub abc()
Dim objShell As Object, objFolder As Object, oFolderItem As Object, Chemin As String

Sheets(Array("1", "2", "3", "4", "C16", "RF1", "RF2")).Select
Sheets("1").Activate

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

On Error Resume Next
Set oFolderItem = objFolder.Items.Item
Chemin = oFolderItem.Path

fName = Chemin & "\Monfichier " & Date & ".pdf"

ChDir Chemin
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, Quality:=xlQualityStandard _
        , IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
Sheets("Données").Select
Range("A1").Select
End Sub

Ca marche

Un grand merci pour votre aide.

Une dernière requête svp: le ficher se nomme "Mon fichier 17.10.18"

   fName = Chemin & "\Mon fichier " & Date & ".pdf"  

Si quelqu'un fait plusieurs variantes le même jour et qu'il sauvegarde dans le même répertoire, la version antérieure est écrasée.

Il faudrait donc que le fichier s'intitule différemment pour chaque cas étudier.

L'utilisateur peut écrire dans l'onglet "Données" dans la cellule B10 le nom de la variante (exemple: "simulation 1")

Ce code ne marche pas ou m'affiche la valeur "Vrai" au lieu du texte écrit dans la cellule b10:

  fName = Chemin & "\Mon fichier" & Sheets("Données").Select Range("B10").Select & Date & ".pdf"           

Pourriez-vous le corriger svp?

Merci

Jacko

re.,

à tester,

fName = Chemin & "\Mon fichier" & Sheets("Données").Range("B10") & Date & ".pdf"  

Clap de fin.

Ca fonctionne. Que dire à part un tout grand merci.

Jacko80