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
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
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:
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