Sauvegarde des feuilles d'un classeur en PDF

Bonjour,

Cette procédure fonctionne pour une feuille .

        'PROCEDURE IMPRESSION D'UNE FEUILLE en PDF

Private Sub Btn_SaveFichierPDF_Click()

Dim LaDate As String
Dim LeNFichier As String
Dim LeRep As String

        Rep = MsgBox("Etes-vous certain de vouloir Enregistrer sous ce nom ?", vbYesNo + vbQuestion, "Sauvegarde du Fichier en  PDF ")

        If Rep = vbYes Then     ' Si réponse positive alors faire la sauvegarde

        LeRep = "J:\11 - Fichiers Excel\RAPPORT ESSAIS PROCESS\"  'Répertoire de destination pour la sauvegarde'

        LeNFichier = (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

        MsgBox (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

       'MsgBox ("Le sujet n° " & UserForm1.TextBox1.Value & "a été ajouté à la date du " & UserForm1.TextBox2.Value)

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        LeRep & LeNFichier & ".pdf", Quality:= _
            xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
            From:=1, To:=2, OpenAfterPublish:=False

         Else

         If Rep = vbNo Then Exit Sub   ' Si réponse Négative sortie de procédure

    End If
            MsgBox "Sauvegarde PDF réalisée!  "

End Sub

J'ai modifier pour avoir la sauvegarde de toutes les feuilles a partir de la N°3 .

        'PROCEDURE SAUVEGARDE DES FEUILLES EN FORMAT PDF

Private Sub Btn_SaveFichierPDF_Click()

Dim LaDate As String
Dim LeNFichier As String
Dim LeRep As String
Dim i As Integer

        Rep = MsgBox("Etes-vous certain de vouloir Enregistrer sous ce nom ?", vbYesNo + vbQuestion, "Sauvegarde du Fichier en  PDF ")

         If Rep = vbYes Then     ' Si réponse positive alors faire la sauvegarde de toutes les feuilles

        LeRep = Sheets("DATA").Range("C2").Value  'Répertoire de destination pour la sauvegarde'
        LeNFichier = (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value) 'Nom du fichier de sauvegarde

        MsgBox (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

         For i = 3 To Sheets.Count   ' A partir de la feuille 3

        With Sheets(i)

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=LeRep & LeNFichier & ".pdf"

        End With

         Else

         If Rep = vbNo Then Exit Sub   ' Si réponse Négative sortie de procédure

    End If

            MsgBox "Sauvegarde PDF réalisée", vbInformation

End Sub

Hélas erreur bloc Else sans If

Avez-vous une solution

Merci de vos lumières

Bonjour ledzep,

Le message d'erreur est là car vous n'avez pas fermé la boucle i

il faut rajouter " Next i " à l'endroit voulut

Slts

à tester comme cela:

        'PROCEDURE SAUVEGARDE DES FEUILLES EN FORMAT PDF

Private Sub Btn_SaveFichierPDF_Click()

Dim LaDate As String
Dim LeNFichier As String
Dim LeRep As String
Dim i As Integer

        Rep = MsgBox("Etes-vous certain de vouloir Enregistrer sous ce nom ?", vbYesNo + vbQuestion, "Sauvegarde du Fichier en  PDF ")

         If Rep = vbYes Then     ' Si réponse positive alors faire la sauvegarde de toutes les feuilles

        LeRep = Sheets("DATA").Range("C2").Value  'Répertoire de destination pour la sauvegarde'
        LeNFichier = (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value) 'Nom du fichier de sauvegarde

        MsgBox (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

         For i = 3 To Sheets.Count   ' A partir de la feuille 3

        With Sheets(i)

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=LeRep & LeNFichier & ".pdf"

        End With

        next i

         Else

         If Rep = vbNo Then Exit Sub   ' Si réponse Négative sortie de procédure

    End If

            MsgBox "Sauvegarde PDF réalisée", vbInformation

End Sub

Par contre ici vous aurez un fichier PDF par feuille et donc surement un problème au niveau du nom de ces PDF

Bonjour

Merci Gabin37 pour ton retour.

Bien sûr le Next i que j'ai oublié .

Par contre ici vous aurez un fichier PDF par feuille et donc surement un problème au niveau du nom de ces PDF

Eh oui je viens de tester, je n'ai que la feuille ou j'ai mon userform qui d’éclanche la sauvegarde, donc pas les autres feuilles

Avez vous une solution à me proposer svp

Merci

Donc si j'ai bien compris vous souhaitez convertir en PDF tout le classeur à l'exception des 3 premiers onglets ?

Dans ce cas le plus simple serait de masquer les 3 premiers onglets avec la propriété suivante:

Sheets(1).visible = false 

Sheets(2).visible = false 

Sheets(3).visible = false 

(Puis les faire réapparaitre à la fin de la macro)

Ensuite pour sauvegarder en PDF au lieu d'utiliser ExportAsFixedFormat sur un onglet, utilisez sur tout le classeur comme cela:

Thisworkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=LeRep & LeNFichier & ".pdf"

J'espère vous avoir donné tout les éléments de réponses.

N'hésitez pas si vous avez besoin d'aide !

Bonjour

Ok je vais essayer de mettre en place votre solution.

Si je bloque à nouveau, je reposte sur ce sujet

Merci de votre aide

Bonjour
Parfait votre solution, Merci

Donc maintenant en paramétrant le format d'impression, j'ai bien un dossier qui possèdent la totalité de mes feuilles.

Maintenant, serait-il possible de sélectionner en fonction le la colonne "G" "PIPE_ELEC_INST_etc" si elle = "CBO_Maintenance.value" de pouvoir les sauvegarder

capt 1 cap 2

en fait la feuille cour ne doit pas faire partie de la sauvegarde puisque il n'y a rien dans la colonne "G"

Pensez-vous que ce soit réalisable.

Si vous voulez je peux joindre mon fichier

Merci de votre retour

Bonjour,

Si vous voulez je peux joindre mon fichier

Il serait le bienvenue.

Vous me parlez de colonne "G" mais les numéros de colonnes ne sont pas visible sur vos capture

En résumé vous avez des tableaux dans certain onglet et si ces derniers sont vides alors ils ne doivent pas apparaitre dans la sauvegarde PDF ?

Comme précédemment, pour que un onglet n'apparaisse pas dans le PDF il faut le faire disparaitre.

Voici un code qui parcours tout les onglets, vous pouvez par exemple y tester une colonne et si elle est vide masquer l'onglet.

Sub test()
Dim feuil As Worksheet
For Each feuil In ThisWorkbook
If feuil.Range("A1") = "" Then feuil.Visible = False
Next feuil
End Sub

A+

Bonsoir

Merci de ta réponse, mais désolé je viens de rentrer et je ne pourrais testé ton code ce soir.

Hier en fouillant sur le net, j'ai trouvé ce bout de code.

Sub Traite_OngletsNonVides()
    Dim i As Integer
    Const CelluleATester = "F28"

    With ActiveWorkbook
        For i = 1 To .Sheets.Count - 1
            With .Sheets(i)
                If .Range(CelluleATester).Value <> 0 Then
                    With .Tab
                        .Color = 5296274
                        .TintAndShade = 0
                    End With
                    .PrintOut Copies:=2
                Else:
                    With .Tab
                        .ThemeColor = xlThemeColorAccent6
                        .TintAndShade = 0.799981688894314
                    End With
                End If
            End With
        Next i
    End With
End Sub

Pour résumer, le programme passe en revue toutes les feuilles de calcul du classeur en cours (ActiveWorkbook) à l’aide de la boucle compteur For… To… Next (sauf la dernière, d’où le -1) : si le contenu de la cellule F28 (constante CelluleATester) est différent de 0 (zéro), l’onglet est coloré en vert et la feuille est imprimée (.PrintOut) en deux exemplaires (Copie:=2). Ceci fait, le programme passe à la feuille suivante (Next).

Je vais essayer de le l’intégrer dans mon code. en fin de semaine, pas de tps libre avant.

Si tu le désires travail le de ton coté, mais ne le publie pas pour l’instant stp, j'aimerai pouvoir trouver la solution moi même.

Par contre si je fais fausse route, dit le moi

Merci et bonne soirée

Salut,

l’onglet est coloré en vert et la feuille est imprimée

Je croyais que tu cherchais à sauvegarder en PDF ?

Salut Gabin37

Je voulais m'inspirer de ce code pour en extraire la partie

Dim i As Integer
    Const CelluleATester = "F28"

    With ActiveWorkbook
        For i = 1 To .Sheets.Count - 1
            With .Sheets(i)
                If .Range(CelluleATester).Value <> 0 Then

Mais je n'y suis pas parvenu.

Je suis assez limité en VBA , mais j'apprends avec ce forum ou sur le net.

Donc si tu peux essayer de m'aider à ne plus avoir une feuille de ce type

cap 2

quand je fais la sauvegarde, cela m'aiderai beaucoup

Je te joint mon fichier réduit en nombre de feuilles .

Je vais continuer de chercher une solution de mon coté

PS: dans la feuille administrateur, j'ai mis une explication sur le déroulement de la procédure.

Merci de ton aide.

Désolé Bonjour aussi au forum

Salut ledzep !

Je vais regarder ton fichier et trouver des pistes pour t'aider !

Déja je l'ouvre j'ai une erreur

La macro open cherche à activer un onglet qui est déjà actif, problème réglé en ajoutant une gestion d'erreur au début:

On Error Resume Next

Je dois avouer que entre ton fichier et les explications que tu as donné au fil des précédents messages je suis un peu perdu.

Tu souhaites un code qui sauvegarde en PDF les onglets sauf:

• Les 3 premiers onglets

• Les onglets avec des tableaux vides

On Error Resume Next
For i = 1 To Sheets.Count
If i < 3 Then
    Sheets(i).Visible = False
Else
    Sheets(i).Visible = False
    For Each Cell In Range("E3:I10000")
    If Not Cell = "" Then Sheets(i).Visible = True
    Next Cell
End If
Next i
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=LeRep & LeNFichier & ".pdf"
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
Sheets(1).Visible = False
Sheets(2).Activate

Essaye de tester ce code, sachant que les variables "LeRep" et "LeNFichier" sont dans le code du premier post

A+

Bonjour le Forum

Bonjour Gabin37

On Error Resume Next

Ah, désolé de mon côte pas eu pour l'instant, pourras tu me donner l'endroit ou tu as corrigé stp

Je vais testé ton code en créant un autre fichier.

Cela sera beaucoup plus simple et compréhensible pour toi et le forum , il est vrai que tu as la totalité du code et que je ne travail que sur une partie de celui-ci.

Samedi et dimanche je suis de nuit, donc j'aurais plus de facilité pour essayer ce bout de code.

Je te remercie pour ton aide.

D'ici là bonne journée à toi et au forum

Bonjour le forum

Bonjour Gabin37

J'ai essayé ton code mais sans sucés (mes connaissances sont trop juste),.

Par contre je me suis rendu compte que j'allais avoir 1 fichier de sauvegardez par feuilles ! ( ici je n'ai mis que 3 feuilles , en réalité il y en 20), donc j'ai mis dans la feuille "ADMINISTRATEUR" un tableau pouvant recevoir l'extraction suivant le choix dans la combobox "CBO_Maintenance"

Cela fonctionne.

Donc maintenant ce code

        ''PROCEDURE FILTRE SUR SECTEUR EXPLOITATION DEPUIS CHOIX CBO_Maintenance

    Private Sub BTNEXTRACTION_Click()

    Dim Lg As Long
    Dim WsS As Worksheet

                'Procédure effacer zone du "Tbl_Extraction" pour recevoir nouvelles données

    Lg = Range("B8").End(xlUp).Row + 1           'Départ de la ligne sélectionnée est B8

    With Range("B" & Lg & ":B600").EntireRow     'A B600
        .Delete                              'Nettoyage

                'Procédure Filtre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord = = = =

    Set WsS = Worksheets("EAUX")        'Identification de la feuille objet
        With WsS.ListObjects("EAUX")
            .Range.AutoFilter Field:=6, Criteria1:=Me.CBO_Maintenance, Operator:=xlAnd
            .DataBodyRange.Copy [B8]            'Copie vers "Tbl_Extraction"
            .Range.AutoFilter Field:=6        'Réinitialiser le filtre du Tableau "EAU"

        End With

     End With

                'Procédure Filtre du tableau DataBase PUIS EXTRACTION vers Tableau de Bord = = = =

        With Range("B" & Lg & ":B600").EntireRow
            .RowHeight = Sheets("DATA").[B3].Value    'Mettre la ligne à la hauteur suivant valeur de CEL B3
            .VerticalAlignment = xlCenter    'Centrée
            .Font.Color = RGB(0, 0, 0)       'Couleur police
            .Font.Bold = True                'Ecriture en Gras
        End With

    End Sub

ne fonctionne que sur la

Set WsS = Worksheets("EAUX") 

Un array va fonctionner, mais si je supprime; ajoute ou modifie le nom d'une des feuilles, je doit aller dans le code pour le modifier

Donc voici ma demande:

1-Extraction de toutes les feuilles du classeur avec le titre de chaque feuilles "B1" juste avant

2- je me suis aperçu que le filtre

.Range.AutoFilter Field:=6, Criteria1:=Me.CBO_Maintenance, Operator:=xlAnd

Fonctionne si le critère est présent, par contre si celui-ci n’existe pas la la feuille , il prend la totalité de la feuille.

Je sais que j'ai pris une autre direction, mais je pense que c'est plus structuré comme cela et surtout plus compréhensible aussi.

Si jamais tu (vous ) trouver que je dois recréer un nouveau sujet dite le moi

Merci de l'aide déjà apporté a ce sujet

Bonjour ledzep,

qu'est ce qui ne fonctionnais pas dans mon code ?

Je ne pense pas avoir précisément saisie ce que tu cherches à faire...

Par contre je me suis rendu compte que j'allais avoir 1 fichier de sauvegardez par feuilles !

Oui.. c'est pour cela que je masquais les onglets qui ne nous intéresse pas avant de sauver le classeur entier en pdf

Que cherche tu as faire avec les filtres ?

tu as dit que tu ne voulais plus avoir de feuilles vides:

image

Je n'ai jamais manipulé de filtres en VBA je ne pourrais pas t'aider. Pour ce qui est du nom de la feuille encore une fois pourquoi ne pas balayer toutes les feuilles du classeur dans une boucle for comme je l'avais proposé ?..

A+

Bonjour le forum

Bonjour Gabin37

Voici ce j'ai mis en place suivant tes recommandations

       'PROCEDURE SAUVEGARDE DES FEUILLES EN FORMAT PDF

Private Sub Btn_SaveFichierPDF_Click()

Dim LaDate As String
Dim LeNFichier As String
Dim LeRep As String
Dim i As Integer

        Application.ScreenUpdating = False

        Rep = MsgBox("Etes-vous certain de vouloir Enregistrer sous ce nom ?", vbYesNo + vbQuestion, "Sauvegarde du Fichier en  PDF ")

    If Rep = vbYes Then     ' Si réponse positive alors faire la sauvegarde de toutes les feuilles

        LeRep = Sheets("DATA").Range("B2").Value   'Répertoire de destination pour la sauvegarde'
        LeNFichier = (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value) 'Nom du fichier de sauvegarde

        MsgBox (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

       On Error Resume Next
For i = 1 To Sheets.Count
If i < 3 Then
    Sheets(i).Visible = False
Else
    Sheets(i).Visible = False
    For Each Cell In Range("E3:I10000")
    If Not Cell = "" Then Sheets(i).Visible = True
    Next Cell
End If
Next i
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=LeRep & LeNFichier & ".pdf"
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
Sheets(1).Visible = False
Sheets(2).Activate

    Else

    If Rep = vbNo Then Exit Sub   ' Si réponse Négative sortie de procédure

    End If
            MsgBox "Sauvegarde PDF réalisée", vbInformation

        Sheets(2).Visible = True

        For i = 3 To Sheets.Count

            With Sheets(i)

                .Range("B3").AutoFilter Field:=6         'Suppression du filtre des Tableaux de toutes les feuilles

            End With

        Next

         Application.ScreenUpdating = True

End Sub

Le code se déroule sans incidents , mais j'ai tours la même feuille vide en PDF (circuit 16)

Re,

En effet petite erreur de ma part. peux tu tester ce code ?

       'PROCEDURE SAUVEGARDE DES FEUILLES EN FORMAT PDF

Private Sub Btn_SaveFichierPDF_Click()

Dim LaDate As String
Dim LeNFichier As String
Dim LeRep As String
Dim i As Integer

        Application.ScreenUpdating = False

        Rep = MsgBox("Etes-vous certain de vouloir Enregistrer sous ce nom ?", vbYesNo + vbQuestion, "Sauvegarde du Fichier en  PDF ")

    If Rep = vbYes Then     ' Si réponse positive alors faire la sauvegarde de toutes les feuilles

        LeRep = Sheets("DATA").Range("B2").Value   'Répertoire de destination pour la sauvegarde'
        LeNFichier = (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value) 'Nom du fichier de sauvegarde

        MsgBox (FRM_Extraction.Txt_Datesave.Value & "_" & FRM_Extraction.TxtNom_Fichier.Value)

       On Error Resume Next
For i = 1 To Sheets.Count
If i < 3 Then
    Sheets(i).Visible = False
Else
    Sheets(i).Visible = False
    For Each Cell In Sheets(i).Range("E3:I10000")
    If Not Cell = "" Then Sheets(i).Visible = True
    Next Cell
End If
Next i
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=LeRep & LeNFichier & ".pdf"
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
Sheets(1).Visible = False
Sheets(2).Activate

    Else

    If Rep = vbNo Then Exit Sub   ' Si réponse Négative sortie de procédure

    End If
            MsgBox "Sauvegarde PDF réalisée", vbInformation

        Sheets(2).Visible = True

        For i = 3 To Sheets.Count

            With Sheets(i)

                .Range("B3").AutoFilter Field:=6         'Suppression du filtre des Tableaux de toutes les feuilles

            End With

        Next

         Application.ScreenUpdating = True

End Sub

Bonjour Gabin37

Merci beaucoup, cela fonctionne très bien.

Je ne ferme pas ce post, pour l'instant, car je vais transférer ton code dans mon fichier final

Merci de ton aide si précieuse .

Bonne journée a toi

Rechercher des sujets similaires à "sauvegarde feuilles classeur pdf"