Création PDF de certains onglets selon condition

Anthonymctm · 10 Septembre 2019

Bonjour à tous,

J'ai un fichier Excel avec une dizaine d'onglets sur lequel j'utilise une macro pour imprimer certains onglets selon la condition ou la cellule Z1=1.

Ca, c'est bon.

J'aimerais ensuite, et c'est là ou j'ai besoin de votre aide, enregistrer un PDF de certains onglets ou Z1=1.

J'ai trouvé cet macro pour enregistrer un pdf de certains onglets et ça fonctionne bien :

VB:

Sub CreerPDF()
    Dim sRep As String
    Dim sFilename As String



    Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
    sRep = ThisWorkbook.Path
    sFilename = ThisWorkbook.Name
    sFilename = Left(sFilename, InStr(1, sFilename, ".")) & "pdf"



    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sRep & sFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
End Sub

Il faudrait juste que je puisse ajouter la condition Z1=1 parmis les onglets listés uniquement (j'ai d'autres onglets ou Z1 =1 que je n'enregistrerai jamais en pdf).

Ci-dessous ma macro global :

Code:

Sub PrintingChoose()

Dim sRep As String
Dim sFilename As String

Dim wb
Worksheets("débit-2").Visible = True
For Each wb In Worksheets 'ou worbooks pour classeurs worksheets si tu veux parcourir les feuilles au lieu des classeurs
  If wb.Range("Z1").Value = 1 Then  'tu verifies la valeur de la cellule Z1 dans la feuille active lors de l'ouverture du classeur. pour le parcours des feuilles au lieu des classeurs, il faut juste enlever ".activesheet"
'   wb.PrintOut 'Lance l'impression du classeur/ de la feuille. Fais juste attention à ce que l'imprimante par défaut soit active
wb.PrintPreview
  End If
Next:D

        Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
    sRep = ThisWorkbook.Path
    sFilename = ThisWorkbook.Name
    sFilename = Left(sFilename, InStr(1, sFilename, ".")) & "pdf"

     ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sRep & sFilename, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True

Worksheets("débit-2").Visible = False
End Sub

Merci !!

Anthonymctm · 23 Septembre 2019

Un petit up

kiki29 · 23 Septembre 2019

Salut, voir ici en bas de ce post 1 : Impression de certaines Feuilles d'un classeur via un tableau dans un seul Pdf résultant
à adapter à ton contexte.

Anthonymctm · 23 Septembre 2019

Salut kiki,

Merci de ta contribution !

Le truc c'est que l'export de ma macro fonctionne, ce que je ne parviens pas à faire c'est ajouter la condition ou Z1=1 parmis les onglets listés.

Il faudrait modifier
Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
par quelque chose du style
Sheets(Array(("Feuil1", "Feuil2", "Feuil3")AND(Z1=1)).Select

Sauf que ça je sais pas le faire

patricktoulon · 23 Septembre 2019

Bonjour
peut etre ceci non?

VB:

Sub SelectedSheetToPdf()
    Dim tableausheet(), Destination As String

    For i = 1 To Sheets.Count
        If Sheets(i).[Z1] = 1 Then x = x + 1: ReDim Preserve tableausheet(1 To x): tableausheet(x) = Sheets(i).Name
    Next

    Destination = ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & "pdf"

    Sheets(tableausheet).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Destination, Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub

il n'y a qu'un seul soucis avec ton truc
si tu n'a pas configurer de PageSetup.PrintArea tu va te retrouver a vec toutes les pages vides entre la première et celle qui contient la cellule Z1
de chaque sheets selectionnés parce que justement si il y a 1 dans [Z1] elle sera prise en compte et plus si il y a d'autre donnée plus loin que la colonne "Z"
je le dis au cas ou
un conseil juste comme ca , si tu pouvais mettre ton repère dans le printarea(1)(page(1) de chaque sheets) se serait plus judicieux les pages s’arrêteraient au usedrange
après sinon se sera plus compliqué il faudra boucler sur les ranges des printareas et controler si elle sont pleines ou vides

kiki29 · 23 Septembre 2019

Salut, dans le code suggéré plus haut, il te suffit de remplacer If Left(Sheets(i).Name, 2) = "RF" Or Left(Sheets(i).Name, 2) = "RC" Then par ta condition sur Z1

VB:

Sub Tst_2007()
Dim sNomFichierPDF As String
Dim i As Long, Cpt As Long
Dim Ar() As String

    sNomFichierPDF = ThisWorkbook.Path & "\" & "Tableau2007.pdf"

    Cpt = 0
    Erase Ar
    For i = 1 To ThisWorkbook.Sheets.Count
        If Sheets(i).Range("Z1") = 1. Then
            ReDim Preserve Ar(Cpt)
            Ar(Cpt) = Sheets(i).Name
            Cpt = Cpt + 1
        End If
    Next i
    If Cpt = 0 Then Exit Sub

    Application.ScreenUpdating = False
    Sheets(Ar).Select

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNomFichierPDF _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

    Feuil1.Select
    Application.ScreenUpdating = True
End Sub

Anthonymctm · 23 Septembre 2019

Salut Patrick,

Merci de ton aide.

Concernant ta macro, on dirait qu'elle ajoutait tous les onglets où Z1=1 et non où Z1=1 parmis certains onglets.

Du coup j'ai rajouté l'info sur les onglets que je souhaitais en Y1 et je regarde en Z1 pour l'impression et en Y1 pour le pdf.

Du coup ça fonctionne bien

Par contre j'ai pas compris la dernière partie de ton message. ^^'

patricktoulon · 23 Septembre 2019

la der niere partie pas compris

ok

imagine ton sheets 1 avec z1=1 remplie de A1 a f10 et x1 a Ab20

il y a bien des pages entre ces deux la et elle sont vides mais le pdf va les prendre quand même

Anthonymctm · 24 Septembre 2019

Ah oui d'accord merci.

Ce n'est pas le cas pour mon fichier donc ça devrait être bon

Création PDF de certains onglets selon condition

Anthonymctm

XLDnaute Occasionnel

Anthonymctm

XLDnaute Occasionnel

kiki29

XLDnaute Barbatruc

Anthonymctm

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

kiki29

XLDnaute Barbatruc

Anthonymctm

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Anthonymctm

XLDnaute Occasionnel

Discussions similaires