Export pdf
Bonjour à tous,
Je reviens avec un nouveau défi
Je suis allé un peu partout sur le forum il y a des sujets approchants mais que je n'arrive pas a adapter, l'enregistreur macro après un filtre m'a décourager
Je joins le fichier test !
Merci d'avance pour votre aide !!!
Cordialement,
Bonjour I20100,
Merci pour ton retour, cependant le code me créer des feuilles excel et non un enregistrement PDF ?,
De plus, à l'ouverture du fichier que tu m'as renvoyé, il manque les onglets Rappro U 02 2020 et Rappro E 02 2020 que je souhaiterais également enregistrés en PDF,
Merci pour ton aide,
Cordialement,
Bonjour massari59264, Isabelle et le Forum,
une proposition à tester, à vérifier le chemin et les espaces dans les nom des onglets:
Sub test()
Dim arr() As Variant
Dim i As Integer
Dim Chemin As String, Fichier1 As String, Fichier2 As String, Fichier3 As String
Dim Wks1 As Worksheet, Wks2 As Worksheet, Wks3 As Worksheet
Chemin = "T:\SEBASTIEN\" '<<===== à adapter
Set Wks1 = ThisWorkbook.Sheets("VENTES 02 2020")
Set Wks2 = ThisWorkbook.Sheets("RAPPRO U 02 2020")
Set Wks3 = ThisWorkbook.Sheets("RAPPRO E 02 2020")
Fichier2 = Chemin & Wks2.Name & ".PDF"
Fichier3 = Chemin & Wks3.Name & ".PDF"
Application.ScreenUpdating = False
arr = Array("F", "Manque X", "Manque Y", "Décomposer Type")
For i = LBound(arr) To UBound(arr)
If arr(i) = "F" Then
Fichier1 = Chemin & Wks1.Name & ".PDF"
Else
Fichier1 = Chemin & arr(i) & ".PDF"
End If
Wks1.ListObjects("VENTES").Range.AutoFilter Field:=11, Criteria1:=arr(i)
Wks1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier1, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Wks1.ListObjects("VENTES").Range.AutoFilter Field:=11
Next i
Wks2.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier2, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Wks3.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier3, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Application.ScreenUpdating = True
End SubBonjour Sequoyah ,
Merci pour ton code qui adapté à mon fichier de travail fonctionne trés bien, cependant j'ai trois remarques et si tu pouvais m'aider pour celles -ci :
1ère remarque : peut on remplacer
Set Wks1 = ThisWorkbook.Sheets("VENTES 02 2020")
Set Wks2 = ThisWorkbook.Sheets("RAPPRO U 02 2020")
Set Wks3 = ThisWorkbook.Sheets("RAPPRO E 02 2020")
en désignant non pas le nom de l’onglet mais le code name de la feuille (sur mon fichier test VENTES 02 2020 correspond au code name Feuil1 etc ...) car celui va varié !
2ème remarque : est il possible que si il n' y a pas de données on importe pas en PDF :
deux exemples :
1-si dans le tableau VENTES il n'y a pas de Manque X dans ce cas on ne crée pas Manque X en PDF
2-si il n'a pas de données dans Rappro U 02 2020 (dans ce cas il n'y aura que le titre et les en têtes), également ne pas crée de PDF
3ème remarque : lors du filtre "F" sur le tableau Vente, peut on lui déterminer comme nom de fichier PDF le nom de l'onglet (ici VENTES O2 2020) celui étant variable !
Sur le fichier joint test il y a le code qui permet de modifier le nom de l'onglet, peut être que ça te sera utile ?,
Il y a une partie de code sur ThisWorkbook et sur la feuil1 !
Merci déjà pour ton aide, ça peut paraitre directif mon retour mais c'est pour bien expliquer mes souhaits,
Merci d'avance,
Cordialement,
Bonjour massari59264,
vois si ça te convient:
Sub test3()
Dim dic As Object, vData As Variant, i As Long, j As Long
Dim arr As Variant
Dim Chemin As String, Fichier1 As String, Fichier2 As String, Fichier3 As String
Dim Wks1 As Worksheet, Wks2 As Worksheet, Wks3 As Worksheet
Dim DLig As Integer
Set Wks1 = ThisWorkbook.Sheets(1)
Set Wks2 = ThisWorkbook.Sheets(2)
Set Wks3 = ThisWorkbook.Sheets(3)
DLig = Wks1.Range("K" & Rows.Count).End(xlUp).Row
Chemin = "T:\SEBASTIEN\" '<<===== à adapter
Fichier2 = Chemin & Wks2.Name & ".PDF"
Fichier3 = Chemin & Wks3.Name & ".PDF"
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
vData = Wks1.Range("K2:K" & DLig)
For i = LBound(vData) To UBound(vData)
If vData(i, 1) <> "NF" Then dic(vData(i, 1)) = Empty
Next i
arr = dic.keys
For j = LBound(arr) To UBound(arr)
If arr(j) = "F" Then
Fichier1 = Chemin & Wks1.Name & ".PDF"
Else
Fichier1 = Chemin & arr(j) & ".PDF"
End If
Wks1.ListObjects("VENTES").Range.AutoFilter Field:=11, Criteria1:=arr(j)
Wks1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier1, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Wks1.ListObjects("VENTES").Range.AutoFilter Field:=11
Next j
If Not IsEmpty(Wks2.Range("A4").Value) Then
Wks2.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier2, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Wks3.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Fichier3, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Application.ScreenUpdating = True
End SubBonjour Sequoyah,
Tout d'abord merci pour le code et ton implication, tout fonctionne comme souhaité
J'aurai une dernière demande si c'est possible : le chemin d'enregistrement amène vers un dossier nommé PDF, j'aurais aimé si c'est possible qu'avant le lancement de la procédure tous les PDF existants de ce dossier sont supprimés afin de conserver les nouveaux PDF créer ! Mais sans supprimer le dossier PDF, uniquement son contenu en PDF,
Désolé de ne pas l'avoir précisé auparavant, c'est à l'utilisation que je m’en suis rendu compte que ce serait bien d'avoir cette aoption !
Merci pour tout, seul je n'y serai pas arrivé !
Cordialement,
Bonjour massari59264,
merci pour ton retour, ajoute cette ligne de code:
Kill chemin & "*.pdf"Attention, cette action est irréversible, les fichiers sont effacés directement sans passer par la corbeille!
Cordialment,
Bonjour Sequoyah,
C'est parfait c'est ce que je souhaitais,
Merci pour tout,
Cordialement,
Bonjour Sequoyah,
J'ai un souci à l'usage c'est qu'il me mets fichier introuvable lorsqu'il n'y a pas de PDF à supprimer (ce qui est le cas au départ)?,
Pourriez vous m'aider?,
Merci d'avance,
Cordialement,
Bonjour Sequoyah,
Aprés quelque recherche, j'ai modifié le code comme ceci est cela fonctionne :
On Error Resume Next
Kill Chemin & "*.pdf" 'efface les PDF avant procédure
On Error GoTo 0En espérant ne pas mettre trompé
Cordialement,
Bonjour massari59264,
même si ça marche, en général il n'est pas recommandé d'utiliser On Error Resume Next, voici une voie alternative:
Sub SupprimePDF()
Dim Chemin As String, FilePDF As String
Chemin = "C:\Users\Sequoyah\Desktop\"
FilePDF = Chemin & "*.pdf"
If Len(Dir$(FilePDF)) > 0 Then
Kill FilePDF
End If
End SubCordialement