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 - 15 déc. 2019 à 16:06

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é !

Afficher la suite

A voir également:

.Displaymemberpropertytooltips = false
Tcd excel - Guide
Via michelin carte - Télécharger - Transports & Cartes
Excel compter cellule couleur sans vba - Guide
Partager des photos via un lien - Guide
ViaMichelin - Télécharger - Transports & Cartes

5 réponses

Réponse 1 / 5

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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?

Réponse 2 / 5

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.

Réponse 3 / 5

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

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.

Réponse 4 / 5

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".

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

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

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

appliquer une pause dans une macro vba excel

Méthode find dans VBA - Recherche de données sous Excel

Erreur d'exécution '13': Incompatibilité de Type

Votre réponse

Discussions similaires