Export PDF de plusieurs onglets

Le 02/07/2018 à 17:36

Bonjour,

Je cherche a adapter un code, qui à l'heure actuel fonctionne et me permet lorsque je mets un "X" dans une cellule de la colonne J d'imprimer l'onglet cité dans la colonne I.

Exemple :

2018 07 02 17 22 46 microsoft excel 1 outil beta mc xlsm

Je souhaite imprimer les onglets :

- Identification, Note de compréhension, Fiche de synthèse, Scénario 1, Annexe.

Je mets donc un "X" dans les cellules J20, J21, J23, J24, J28.

2018 07 02 17 37 02 microsoft excel 1 outil beta mc xlsm

Ensuite il me propose de sélectionner l'imprimante et lance l'impression.

2018 07 02 17 39 03 microsoft excel 1 outil beta mc xlsm 2018 07 02 17 38 35 microsoft excel 1 outil beta mc xlsm

Ci dessous vous trouverez le code que j'utilise actuellement.

Sub impressions_retour()
Dim nom As String
Dim prenom As String
Dim adresse1 As String
Dim adresse2 As String
Dim Chemin As String
Dim Chemin1 As String
Dim Chemin2 As String
Dim sCurPrinter As String

   With Application
        sCurPrinter = .ActivePrinter       ' Store current printer.
        MsgBox ("Choix imprimante N&B A3 R:")
        X = Application.Dialogs(xlDialogPrinterSetup).Show
        If X = False Then Exit Sub
        imprimnb = .ActivePrinter
        MsgBox ("Choix imprimante COUL A4 R-V:")
        X = Application.Dialogs(xlDialogPrinterSetup).Show
        If X = False Then Exit Sub
        imprimcoul = .ActivePrinter
   End With

'IMPRESSION IDENTIFICATION
If (Range("J20") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Identification").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    .ActivePrinter = sCurPrinter
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE NOTE DE COMPREHENSION
If (Range("J21") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Note de compréhension").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE ETAT DES LIEUX EXISTANT (1-2)
If (Range("J22") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Etat des lieux existant (1-2)").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE FICHE SYNTHESE
If (Range("J23") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Fiche synthèse").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE SCENARIO 1
If (Range("J24") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Scénario 1").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE SCENARIO 2
If (Range("J25") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Scénario 2").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE SCENARIO 3
If (Range("J26") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Scénario 3").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE SCENARIO 4
If (Range("J27") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Scénario 4").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE ANNEXE
If (Range("J28") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Annexe").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

'IMPRESSION DE PLAN DE FINANCEMENT
If (Range("J29") = "X") Then
With Application
    .ActivePrinter = imprimcoul
    Sheets("Plan de financement").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    Sheets("fiche renseignements").Select
End With
End If

End Sub

Cependant, je souhaiterais remplacer le module impression par un module d'export en PDF en gardant le même système de "X" pour sélectionner le ou les onglet(s).

En espérant avoir été assez clair...

Je reste à votre disposition si vous avez besoin de renseignement complémentaire.

Cordialement,

Morgan

Le 02/07/2018 à 18:23

Bonsoir Morgan2835 le forum

la première partie de ta macro ne sert à rien puisque toutes tes actions ensuite sont en imprimcouleur donc tu peux supprimer

le ci-dessous

Pour le reste je te fais cela demain matin

a+

Papou 

With Application
        sCurPrinter = .ActivePrinter       ' Store current printer.
        MsgBox ("Choix imprimante N&B A3 R:")
        X = Application.Dialogs(xlDialogPrinterSetup).Show
        If X = False Then Exit Sub
        imprimnb = .ActivePrinter
        MsgBox ("Choix imprimante COUL A4 R-V:")
        X = Application.Dialogs(xlDialogPrinterSetup).Show
        If X = False Then Exit Sub
        imprimcoul = .ActivePrinter
   End With
Le 02/07/2018 à 19:27

D'accord, je vais supprimer cela alors.

Je te remercie

Le 02/07/2018 à 19:40

Bonsoir Morgan 2835 le forum

mais tu n'as pas joint ton fichier, moi je veux te faire une boucle mais il me faut le nom de la feuille qui contient ta liste de feuille à cocher

a+

papou

Le 03/07/2018 à 08:21

Hello Papou ,

Le nom de la feuille qui contient ma liste de feuille à cocher est fiche renseignements.

Dis moi si cela te conviens.

a+ Morgan

Le 03/07/2018 à 13:25

Ré morgan2885 le forum

La je rentre du boulot une petite sieste et je te fais ta macro

A plus

Papou

Le 03/07/2018 à 13:34

Super Papou, je te remercie

Bonne sieste alors

A+ Morgan

Le 03/07/2018 à 15:59

Re Bonjour Morgan 2835 le forum

j'ai nommé les fichiers pdf du nom de la feuille suivi de la date au format yyyy mm dd .pdf

et les fichiers seront créés dans le même dossier que ton fichier Morgan2835 V1

teste et redis moi

a+

Papou

16morgan-2835-v1.xlsm (32.77 Ko)
Le 03/07/2018 à 16:15

Re Papou ,

1000 merci, je viens de tester le fichier que tu as fait et il fonctionne parfaitement.

Tu penses qu'il serait possible de faire un seul fichier PDF ?

Morgan

Le 03/07/2018 à 16:53

Bonjour Morgan2835 le forum

bah je pense que oui, mais là c'est un peu plus compliqué, il faut créer une feuille qui récapitule tes choix de feuille et seulement après l'imprimer

mais si tu veux je teste et je te redis , mais a vrai dire je ne l'ai jamais fait

je fais et je te passe le fichier quand c'est ok

A+

papou

Le 03/07/2018 à 17:36

Re Papou,

En effet je souhaiterais que cela me sorte un fichier en PDF car le but étant d'envoyer le rapport par mail afin d'éviter de devoir l'envoyer par courrier.

Economie, écologie :p

Je t'avoue que cela serait le must

Morgan

Le 03/07/2018 à 17:39

Re Morgan 2835 le forum

ton fichier en retour non du fichier Liste et la date format YYYY MM DD et .pdf

a+

Papou

9morgan-2835-v2.xlsm (42.12 Ko)
Le 03/07/2018 à 18:00

Waouh c'est exactement ce que je voulais.

Je l'adapte pour mon classeur et je te redis :p

Merci beaucup, Morgan

Le 03/07/2018 à 18:03

Re Morgan2835 le forum

oui ok j'attends que tu me redises

a+

Papou

Le 03/07/2018 à 18:09

Bonjour

une autre solution pour faire un fichier PDF

modification de la macro de paritec que je salut

Sub ChoixOnglet()
Dim Myarray() As String
Dim I&, L&, Fin&
I = 0
    With Feuil1
        Fin = .Range("I" & Rows.Count).End(3).Row
        For L = 20 To Fin
            If .Cells(L, 10).Value = "X" Then
                I = I + 1
            End If
        Next
        L = I - 1
        ReDim Myarray(L)
I = 0
        For L = 20 To Fin
            If UCase(.Cells(L, 10).Value) = "X" Then
                Myarray(I) = .Cells(L, 9).Value
                I = I + 1
            End If
        Next
    End With
Sheets(Myarray()).Select

NomDossier = "STAT"
   Chemin = ThisWorkbook.Path & "\"
   NomFiche = Chemin & NomDossier & Format(Now, "-dd-mmmm-yyyy") & ".pdf"
   Call EditionPDF(NomFiche)
 MsgBox "Edition Terminer"
Feuil1.Select
End Sub

Sub EditionPDF(NomFiche)
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=NomFiche, _
      Quality:=xlQualityMinimum, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=False
End Sub

A+

Maurice

Le 03/07/2018 à 18:26
paritec a écrit :

Re Morgan2835 le forum

oui ok j'attends que tu me redises

a+

Papou

Hé bien, j'ai du mal. Ça bloque au niveau de l'export...

je te joints mon fichier avec 2 captures d'écran afin que tu te rende compte de mon niveau lol

2018 07 03 18 23 20 microsoft visual basic pour applications 1 outil mc2835 xlsm execution en cou 2018 07 03 18 23 39 microsoft visual basic pour applications 1 outil mc2835 xlsm arret module
61-outil-mc2835.xlsm (434.78 Ko)

Morgan

Le 03/07/2018 à 18:28
archer a écrit :

Bonjour

une autre solution pour faire un fichier PDF

modification de la macro de paritec que je salut

Sub ChoixOnglet()
Dim Myarray() As String
Dim I&, L&, Fin&
I = 0
    With Feuil1
        Fin = .Range("I" & Rows.Count).End(3).Row
        For L = 20 To Fin
            If .Cells(L, 10).Value = "X" Then
                I = I + 1
            End If
        Next
        L = I - 1
        ReDim Myarray(L)
I = 0
        For L = 20 To Fin
            If UCase(.Cells(L, 10).Value) = "X" Then
                Myarray(I) = .Cells(L, 9).Value
                I = I + 1
            End If
        Next
    End With
Sheets(Myarray()).Select

NomDossier = "STAT"
   Chemin = ThisWorkbook.Path & "\"
   NomFiche = Chemin & NomDossier & Format(Now, "-dd-mmmm-yyyy") & ".pdf"
   Call EditionPDF(NomFiche)
 MsgBox "Edition Terminer"
Feuil1.Select
End Sub

Sub EditionPDF(NomFiche)
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
      Filename:=NomFiche, _
      Quality:=xlQualityMinimum, _
      IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, _
      OpenAfterPublish:=False
End Sub

A+

Maurice

Bonjour Maurice, merci beaucoup pour ta proposition.

Je teste ça et je te redis Qu'est-ce qui pourrait différer de la version de papou ?

A+ Morgan

Le 03/07/2018 à 18:37

Bonjour

une petite modife car si tu coche rien ca plante

Sub ChoixOnglet()
Dim Myarray() As String
Dim I&, L&, Fin&
I = 0
    With Feuil1
        Fin = .Range("I" & Rows.Count).End(3).Row
        For L = 20 To Fin
            If .Cells(L, 10).Value = "X" Then
                I = I + 1
            End If
        Next
If I = 0 Then MsgBox "Pas de choix": Exit Sub
        L = I - 1
        ReDim Myarray(L)
I = 0
        For L = 20 To Fin
            If UCase(.Cells(L, 10).Value) = "X" Then
                Myarray(I) = .Cells(L, 9).Value
                I = I + 1
            End If
        Next
    End With
Sheets(Myarray()).Select

NomDossier = "STAT"
   Chemin = ThisWorkbook.Path & "\"
   NomFiche = Chemin & NomDossier & Format(Now, "-dd-mmmm-yyyy") & ".pdf"
   Call EditionPDF(NomFiche)
 MsgBox "Edition Terminer"
Feuil1.Select
End Sub

et pour ton fichier on peux rien faire devine ??

A+

Maurice

Le 04/07/2018 à 07:47

Bonjour Morgan2835 le forum

bah moi je te passe un fichier qui tourne parfaitement et toi tu ne sais pas l'adapter !!!!

Alors la conclusion est que la prochaine fois, tu passeras, ton fichier au début, et tu auras la réponse qui conviendra, du premier coup!!!

C'est toujours pareil, en plus tu me dis que la feuille avec ta liste s'appelle Fiche de renseignement, et dans ton fichier elle s'appelle Impression ??????

Bref avec des renseignements aussi mauvais que peut-on faire??

Et la cerise sur le gâteau, tu passes enfin ton fichier, mais tu prends bien soin de mettre un mot de passe au vba !!!!!!!!

alors alors!!!!

Bref tu as encore besoin de moi ou pas, si oui tu me le redis, je n'ai pas regardé la macro de Maurice, mais si elle est ok pour toi??

merci de me redire la suite à donner stp

a+

papou

Le 04/07/2018 à 11:23

Hello Papou,

Ton verdict est bon... Je n'ai pas voulu te passer mon fichier directement afin que je puisse essayer de comprendre pour pouvoir l'adapter sur mon fichier. Sauf que la je bloque totalement... Concernant le mot de passe du project VBA c'est un oublie de ma part

Oui j'aimerais bien que tu m'aides une dernière fois si tu en a l'envie. Je te joins mon fichier excel, ou il y a bien l'onglet "IMPRESSION" c'est la que je souhaiterais imprimer (ça c'est bon) et exporter en PDF (la je bloque)

4morgan-2835-v3.xlsm (370.59 Ko)

En tous les cas, je te remercie pour ce que tu m'as envoyé.

A+ Morgan

Rechercher des sujets similaires à "export pdf onglets"