Microsoft 365 VBA loop sur pivot table & pdf bug

[Excel65]

Bonjour,
Je developpe un outil sous VBA qui doit produire un rapport par ligne de produit avec 1 ou plus page(s).
je combine fdu VBA pour rafraichir les tables pivot et j'utiulise VBA pour grouper les rapports par ligne produit.

Pour cela j'ai des datas que je mets ds une table pivot.
J'ai ensuite defini une methode pour grouper par type de produit (donc si j'ai 2 produits comme la ligne produit B, la macro est cense produire un pdf avec 2 pages).

j'ai 2 problemes:
Le PDF ne se produit pas mais j'arrive pas a voir le probleme. il doit y avoir une erreur de frappe mais je la vois pas.
Plus difficile, je ne comprends pas pourquoi ma table pivot ne se rafraichit pas...il n'y a pas de loop.

je ne suis pas loin d'avoir l'outil complet mais je bloque et je ne trouve pas l'erreur dans le code.

si quelqu'un peut m'aider a conclure ce petit projet, je l'en remercie.
Bonne journee

X65000

 

[kiki29]

Salut, après nettoyage, ajouts et corrections, en espérant ne rien avoir oublié, à toi de poursuivre.

 

[Excel65]

Bonjour Kiki29, je te remercie pour ton aide.
le PDF est bien produit mais le produit B devrait generer un PDF avec 2 pages.
pour le produit B, les codes sont BBB et VVV donc la macro doit voir que je cree 2 pages (1 page par code) et que le resultat doit donner un PDF en 2 pages.
l'objectif de la macro est de creer un PDF par ligne de produit et chaque page doit etre specificque par Code produit.
Donc si une ligne produit a 40 references, je cherche a produire n PDF de 40 pages.

autre question qui est mon deuxieme point:
As tu compris pourquoi le PDF ne se rafraichissait pas?

Set pf1 = ActiveSheet.PivotTables("PivotTable1").PivotFields("Code")
Set pf2 = ActiveSheet.PivotTables("PivotTable2").PivotFields("Code")

pf1.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
pf2.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value

ActiveSheet.RefreshAll
ActiveSheet.Move After:=Workbooks(strDest).Sheets(1)

Le code est cense aussi rafraichir les tables donc pour produit A, j'ai la pivot table qui devrait se rafraichir et prendre TTT, ensuite pour produit B, la macro doit faire une loop sur la pivot et selectionner produit B....

merci

 

[Excel65]

Bonsoir, j ai trouve le petit probleme.
Merci
le code final:

Sub create_Tab()
Dim nmB As String
Dim wsh_somme, wsh_data As Worksheet
Dim Lignes As Long, k As Long
Dim Lastfund As Long, Lastrow As Long
Dim pf1 As PivotField
Dim pf2 As PivotField
Dim i As Long, Deb As Currency
Dim mySheet As Object
Dim strFilePath As String, strSource As String, Rng As Range, Rang As Range
Dim NewBook As Workbook, strDest As String, rangeName, strFileName As String

Deb = Timer
Application.StatusBar = ""
strFilePath = ActiveWorkbook.Path & "\" & "Output" & "\"

If CreationDossier(strFilePath) = False Then Exit Sub

strSource = ActiveWorkbook.Name

Set wsh_somme = Worksheets(shTemplate.Name)
Set wsh_data = Worksheets(shStatic.Name)

On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Lignes = wsh_data.Cells(Rows.Count, 1).End(xlUp).Row

Lastfund = shStatic.Cells(Rows.Count, 1).End(xlUp).Row

Set Rng = Application.Range("Static!A2:F" & Lastfund)

Lastrow = shStatic.Cells(Rows.Count, 11).End(xlUp).Row

If Lastrow > 1 Then
shStatic.Range("K2:K" & Lastrow) = ""
End If

shStatic.Range("F1:F" & Lastfund).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=shStatic.Range("K1"), _
Unique:=True

Lastrow = shStatic.Cells(Rows.Count, 11).End(xlUp).Row
Set Rang = shStatic.Range("K2:K" & Lastrow)

For k = 1 To Rang.Rows.Count
Set NewBook = Workbooks.Add
strDest = ActiveWorkbook.Name
rangeName = Rang.Cells(RowIndex:=k).Value

For i = 1 To Rng.Rows.Count

If Not IsEmpty(Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value) Then
If Rng.Cells(RowIndex:=i, ColumnIndex:="F").Value = rangeName Then
Workbooks(strSource).Activate
nmB = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
wsh_somme.Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nmB

Set pf1 = ActiveSheet.PivotTables("PivotTable1").PivotFields("Portfolio")
Set pf2 = ActiveSheet.PivotTables("PivotTable2").PivotFields("Portfolio")

pf1.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value
pf2.CurrentPage = Rng.Cells(RowIndex:=i, ColumnIndex:="G").Value

ActiveSheet.RefreshAll
ActiveSheet.Move After:=Workbooks(strDest).Sheets(1)
End If
End If
Next i

Workbooks(strDest).Sheets("Sheet1").Delete
strFileName = Format(shStatic.Range("Import_Date"), "yyyymmdd") & " - " & rangeName

For Each mySheet In Sheets
With mySheet
If .Visible = True Then .Select Replace:=False
End With
Next mySheet

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strFilePath & strFileName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Workbooks(strDest).Close
Next k

With Application
.DisplayAlerts = True
.ScreenUpdating = True
.StatusBar = Format(Timer - Deb, "0.00 s") & " : Terminé"
End With
End Sub