Tcd via VBA

Résolu
Bubus31 Messages postés 57 Date d'inscription   Statut Membre Dernière intervention   -  
Bubus31 Messages postés 57 Date d'inscription   Statut Membre Dernière intervention   -
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. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
  2. Bubus31 Messages postés 57 Date d'inscription   Statut Membre Dernière intervention  
     
    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
  3. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
  4. Bubus31 Messages postés 57 Date d'inscription   Statut Membre Dernière intervention  
     
    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
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Bubus31 Messages postés 57 Date d'inscription   Statut Membre Dernière intervention  
     
    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