Discussion :

[Pierre Ambre]

Bonjour à tous !

Tout d'abord un grand merci à la communauté même si je bloque sur ce problème, ce forum m'a aidé dans des plusieurs cas où j'étais bloqué grâce à de nombreux posts
Aujourd'hui j'ai un petit problème : Je souhaiterais réaliser un enregistrement PDF d'un tableau pour chaque ville faisant partie de la colonne E.
Ainsi, Paris aurait 19 Lignes et ne donnerait que les infos de Paris et Avignon n'en montrerait qu'une. Fréjus ne fait pas partie des données mais pourrait possiblement, tout comme Bastia.

Les villes faisant partie de la colonne variant extrêmement, je ne peux toutes les citer une à une dans une liste.

J'étais parti sur un code comme ceci mais je n'y arrive point

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim DerLig As Long, lig As Long
DerLig = Worksheets("Liste").Range("B7").End(xlDown).Row
 
Dim Nom$, DateMoisPrec$, AnneeMoisPrec$ 'Déclaration des variables
Nom = "Stock 150j Total "  'Nom de l'onglet à entregistrer
DateMoisPrec = MonthName(Month(Date - 30), False) & " " ' formatage date et heure
AnneeMoisPrec = Year(Date - 30)
Rep = "O:\ ventes\b. Stock\"   ' Chemin du répertoire à adapter depuis votre PC
 
ActiveSheet.Range("B6:B" & DerLig).AutoFilter Field:=5, Criteria1:="Paris", Operator:=xlOr, Criteria2:="Fréjus", Operator:=xlOr, Criteria3:="Marseille"
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Rep & Nom & DateMoisPrec & AnneeMoisPrec & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False

La perfection serait que l'extract se fasse jusqu'à la dernière ligne du tableau pour chaque enregistrement

Exemple.xlsm

[78chris]

Bonjour

Je te conseille en début de procédure d'extraire par filtre avancé la liste sans doublons des villes.

Ainsi tu pourras faire une boucle pour filtrer, ville par ville, et imprimer en pdf...

[boisgontierjacques]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Extrait()
  Répertoire = "c:\mesdoc\"            ' Adapter
  Set f = Sheets("Liste")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  f.[L1] = f.[d1]                      ' Colonne critère (adapter)
  Nlig = f.[A1].CurrentRegion.Rows.Count
  Ncol = f.[A1].CurrentRegion.Columns.Count
  '--- Liste des villes
  Sheets("extrait").Select
  f.[A1].Resize(Nlig, Ncol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[L1], Unique:=True
  For Each c In f.Range("L2:L" & f.[L65000].End(xlUp).Row)   ' pour chaque service
     f.[L2] = c.Value
     NomFichier = c.Value
     '-- extraction
     Cells.ClearContents
     f.[A1].Resize(Nlig, Ncol).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[L1:L2], CopyToRange:=[A1]
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
      Répertoire & NomFichier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
   Next c
   f.Select
End Sub

Boisgontier

[Pierre Ambre]

Salut Boisgontier

J'essaye de l'adapter à mon fichier d'origine ! C'est fonctionnel dans ton fichier en tout cas je te remercie. Pas bête de passer par une feuille annexe pour copier les valeurs et les enregistrer en PDF avant de passer au centre suivant. J'ai envoyé mon dernier message avant de voir le tien. Je débute encore sur VBA (oui ça se voit) et vos aides sont très précieuses.

[Pierre Ambre]

Après de multiples heures à tenter diverses combinaisons, coupages de code pour voir ce qui fonctionnait et ce qui ne fonctionnait pas, je n'y suis pas arrivé

Voici le code (entièrement inspiré de la réponse de Boisgontier) et le fichier contenant cette même macro. Peut être que la version de Boisgontier ne marche seulement quand le tableau est en A1 ? Pour d'autres extractions, je dois laisser le tableau en B6 malheureusement.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub Extrait()
  Répertoire = "O:\Coordination des ventes\b. William\4.Stock"            ' Adapter
  Set f = Sheets("Liste")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  f.[H6] = f.[E6]                      ' Colonne critère (adapter)
  Nlig = f.[B6].CurrentRegion.Rows.Count
  Ncol = f.[B6].CurrentRegion.Columns.Count
  '--- Liste des villes
  Sheets("extrait").Select
  f.[B6].Resize(Nlig, Ncol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[H6], Unique:=True
  For Each c In f.Range("H7:H" & f.[L65000].End(xlUp).Row)   ' pour chaque service
     f.[H7] = c.Value
     NomFichier = c.Value
     '-- extraction
     Cells.ClearContents
     f.[B6].Resize(Nlig, Ncol).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[H6:H7], CopyToRange:=[B6]
     ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
      Répertoire & NomFichier & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
      IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
   Next c
   f.Select
End Sub

Essai adaptation.xlsm

[Pierre Ambre]

J'ai pris notes de ton idée qui est je pense très bonne et la plus simple et je suis arrivé à ce code là.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Extraction()
'
'
 
'
    ' Copie colle toutes les valeurs colonne E en colonne J
 
    Range("E7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("J7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
 
' DerLigCentre = dernière ligne de ma liste de doubloin
' DerLigTableau = dernière ligne de mon tableau non filtré
 
Dim DerLigCentre As Long, DerLigTableau As Long, lig As Long, Liste As Worksheet
Set Liste = Worksheets("Liste")
DerLigCentre = Liste.Range("J1").End(xlDown).Row
DerLigTableau = Liste.Range("B1").End(xlDown).Row
 
'Suppression des doublons de la liste en J
 
    ActiveSheet.Range("$J$7: J" & DerLigCentre).RemoveDuplicates Columns:=1, Header:=xlNo
    Range("B7").Select
 
'Faire une extraction pour chaque centre avec dans le nom du fichier le nom du centre
 
Dim rng As Range: Set rng = Application.Range("J7:J" & DerLigCentre)
Dim i As Integer
For i = 1 To rng.Rows.Count
 
    ActiveSheet.Range("$A$6:A" & DerLigTableau).AutoFilter Field:=1, Criteria1:=Array(i), Operator:=xlFilterValues
 
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "O:\Coordination des ventes\b. Pierre\4.Stock\Extract" & "i" & ".pdf", Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
Next
 
End Sub

Je n'arrive cependant pas à filtrer avec les valeurs texte inscrites en colonne J puis imprimer. Je pense que mon code est proche d'être effectif mais c'est l'intégration du filtre dans la boucle qui cloche