Tcd via VBA [Résolu]

Signaler
Messages postés
4
Date d'inscription
samedi 14 décembre 2019
Statut
Membre
Dernière intervention
15 décembre 2019
-
Bubus31
Messages postés
4
Date d'inscription
samedi 14 décembre 2019
Statut
Membre
Dernière intervention
15 décembre 2019
-
Bonjour à tous,

je me jette dans le monde de VBA afin d'optimiser des tâches. Ne sachant pas comment coder pour l'instant, je m'aide de l'enregistreur de macro.
Seulement, j'ai des messages d'erreur qui s'affichent et je ne sais pas comment les corriger...

Contexte: j'ai 5 feuilles (du lundi au vendredi) et j'aimerai exécuter une mise en forme en une seule fois via une macro.

Procédure:

-sur toutes les feuilles (lundi,mardi,mercredi,jeudi,vendredi)
-sélectionner les colonnes de A à F
-insérer un TCD de chaque jours sur une autre feuille (1 pour le lundi, 1 pour le mardi…)

-Mettre les variables dans les champs :
Filtres --> critère
Colonnes --> rien
Lignes --> Nombre de désignation (désignation)
Valeurs -->Désignation (libéllé)

-Filtrer sur « pas passés »
-Insérer un tableau de style histogramme sur la sélection du croisé dynamique

Pour l’instant j’arrive bien à sélectionner les colonnes (A : F) de chaque feuilles mais après c’est le flou artistique.

Merci d'avance à la communauté !

5 réponses

Messages postés
9398
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
25 janvier 2020
496
suggestion:
Option Explicit

Sub Creation_TCD()
Dim fjour As Worksheet, ftcd As Worksheet, pch As PivotCache, ptb As PivotTable
Dim histo As Chart, ntcd As String, confirm As Boolean
Set fjour = Sheets("12 nov 2019")
ntcd = "tcd " & fjour.Name
For Each ftcd In ThisWorkbook.Sheets
    If ftcd.Name = ntcd Then
        confirm = Application.DisplayAlerts
        Application.DisplayAlerts = False
        Call ftcd.Delete
        Application.DisplayAlerts = confirm
        Exit For
    End If
Next ftcd
Set ftcd = ThisWorkbook.Sheets.Add
ftcd.Name = ntcd
Set pch = ThisWorkbook.PivotCaches.Create(xlDatabase, fjour.[A:F])
Set ptb = pch.CreatePivotTable(ftcd.[A3])
With ptb
    .ColumnGrand = True
    .HasAutoFormat = True
    .DisplayErrorString = False
    .DisplayNullString = True
    .EnableDrilldown = True
    .ErrorString = ""
    .MergeLabels = False
    .NullString = ""
    .PageFieldOrder = 2
    .PageFieldWrapCount = 0
    .PreserveFormatting = True
    .RowGrand = True
    .SaveData = True
    .PrintTitles = False
    .RepeatItemsOnEachPrintedPage = True
    .TotalsAnnotation = False
    .CompactRowIndent = 1
    .InGridDropZones = False
    .DisplayFieldCaptions = True
    .DisplayMemberPropertyTooltips = False
    .DisplayContextTooltips = True
    .ShowDrillIndicators = True
    .PrintDrillIndicators = False
    .AllowMultipleFilters = False
    .SortUsingCustomLists = True
    .FieldListSortAscending = False
    .ShowValuesRow = False
    .CalculatedMembersInFilters = False
    .RowAxisLayout xlCompactRow
End With
pch.RefreshOnFileOpen = False
pch.MissingItemsLimit = xlMissingItemsDefault
ptb.RepeatAllLabels xlRepeatLabels
With ptb.PivotFields("Désignation (libellé)")
    .Orientation = xlRowField
    .Position = 1
End With
ptb.AddDataField ptb.PivotFields("Désignation (libellé)"), "Nombre de Désignation (libellé)", xlCount
With ptb.PivotFields("critere")
    .Orientation = xlPageField
    .Position = 1
    .CurrentPage = "(All)"
    .PivotItems("OK").Visible = False
    .PivotItems("(blank)").Visible = False
    .EnableMultiplePageItems = True
End With
Set histo = ftcd.Shapes.AddChart2(201, xlColumnClustered).Chart
histo.SetSourceData source:=ftcd.[A3:B30]
End Sub
si cela fonctionne bien, il faut ajouter la récurrence. comment connaitre les noms des feuilles à traiter? ce sont toutes les feuilles du classeur?
Messages postés
4
Date d'inscription
samedi 14 décembre 2019
Statut
Membre
Dernière intervention
15 décembre 2019

Sub Creation_TCD()
'
' Creation_TCD Macro
'

'
    Columns("A:F").Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "12 nov 2019!R1C1:R1048576C6", Version:=6).CreatePivotTable TableDestination _
        :="Feuil1!R3C1", TableName:="Tableau croisé dynamique1", DefaultVersion:=6
    Sheets("Feuil1").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").RepeatAllLabels _
        xlRepeatLabels
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Désignation (libellé)")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique1").PivotFields("Désignation (libellé)"), _
        "Nombre de Désignation (libellé)", xlCount
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("critere" _
        )
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("critere"). _
        CurrentPage = "(All)"
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("critere" _
        )
        .PivotItems("OK").Visible = False
        .PivotItems("(blank)").Visible = False
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("critere"). _
        EnableMultiplePageItems = True
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("Feuil1!$A$3:$B$30")
End Sub






Ci dessus les différentes actions avec l'enregistreur mentionnées dans mon premier message, je n'ai pas intégré ici la récurrence sur chaque feuilles.
Messages postés
9398
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
25 janvier 2020
496
bonjour,
merci d'utiliser les balises de code quand tu postes du code: https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
tu as des messages d'erreur: lesquels, sur quelle ligne de code?
pour t'aider au mieux, peux-tu un peu te présenter, décrire tes connaissances/intérêts en programmation?
peut-être partager ton fichier, pour faciliter la collaboration?

le plus utile à faire, quand on part de code enregistré par macro: modifier le code pour supprimer les select, utiliser des variables, et ajouter
option explicit
en début de module. dans ton cas, faisons cela avant d'ajouter la récurrence.
Messages postés
4
Date d'inscription
samedi 14 décembre 2019
Statut
Membre
Dernière intervention
15 décembre 2019

salut à tous,

j'ai à priori réussis à trouver une variante en gardant les tcd et graphiques sur les feuilles qui se changent en automatique lorsque j'implémente les nouvelles données.

Voici ce que le codage donne pour le lundi par exemple:

Private Sub Worksheet_Activate()
 Sheets("Analyse lundi").Select
    ActiveWorkbook.RefreshAll
End Sub



et ce pour tous les jours de la semaine en changeant "analyse lundi", "analyse mardi" etc...

Cela évite de recréer les tableaux et graphiques, ils se mettent à jour dès que je vais dans la feuille "analyse lundi".
Messages postés
4
Date d'inscription
samedi 14 décembre 2019
Statut
Membre
Dernière intervention
15 décembre 2019

Bonjour yg_be,

D'abord, merci pour ton retour, j'ai pris en compte ta demande concernant les lignes de code, c'est beaucoup plus visuel en effet.
Personnellement je n'ai pratiquement aucune connaissances en VBA pour l'instant.
J’espère apprendre sur le tas avec la communauté de "Comment ca marche"

Bubus31