Tcd via VBA

Résolu
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

  1. 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.
    0
    1. Contributeur
      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.
      0
      1. Contributeur
        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?
        1
        1. 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".
          0
          1. 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
            0