Discussion :

[lumpys]

Bonjour,

J'ai un fichier Excel avec une feuille qui contient un tableau croisé dynamique avec un graphique. (Cf fichier ci-joint feuille "TCD par service").

J'aurais besoin d'automatiser l'action suivante : qu'il soit en mesure de changer automatiquement le service et qu'à chaque fois qu'il fait cela qu'il enregistre automatiquement la feuille en pdf dans un dossier en particulier.

Pensez-vous que cela soit faisable ? Si oui, comment faire ?

Merci d'avance si vous avez des réponses.

[Invité]

Bonjour,

Une solution possible avec le code ci-dessous. Il faut que votre fichier soit du type .xlsm pour accepter les macros. Les fichiers Pdf sont édités dans le même répertoire que le fichier .xlsm, sinon il vous faut modifier le chemin dans la variable Repertoire.

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
43
44
45
46
 
Sub AutomatisationItemsEtSauvegardePdf()
 
Dim ShTcd As Worksheet
Dim Pvt As PivotTable
Dim PvtItem As PivotItem
Dim Repertoire As String
 
    Repertoire = ActiveWorkbook.Path  ' A modifier le cas échéant
    Set ShTcd = Sheets("TCD par service")
    If ShTcd.PivotTables.Count > 0 Then
        Set Pvt = ShTcd.PivotTables(1)
        For Each PvtItem In Pvt.PivotFields("SERVICE").PivotItems
            ' MsgBox PvtItem.Name
             With Pvt.PivotFields("SERVICE")
                    .ClearAllFilters
                    .CurrentPage = PvtItem.Name
                    ShTcd.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                           Repertoire & "\Absentéisme par service " & DateDeCreationFichier & " " & PvtItem.Name & ".pdf", Quality:= _
                           xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        Next PvtItem
        Set Pvt = Nothing
    End If
    Set ShTcd = Nothing
 
End Sub
 
 
Function DateDeCreationFichier()
 
    DateDeCreationFichier = Year(Date) & "-"
 
    If Month(Date) < 10 Then
        DateDeCreationFichier = DateDeCreationFichier & "0" & Month(Date) & "-"
    Else
        DateDeCreationFichier = DateDeCreationFichier & Month(Date) & "-"
    End If
 
    If Day(Date) < 10 Then
        DateDeCreationFichier = DateDeCreationFichier & "0" & Day(Date)
    Else
        DateDeCreationFichier = DateDeCreationFichier & Day(Date)
    End If
 
End Function

Cordialement.

[lumpys]

Merci beaucoup. Ca fonctionne et c'est tout à fait ce dont j'avais besoin.