Macro Excel TCD

G

groota

XLDnaute Nouveau
Bonjour,
Je suis entrain de faire la mise en page d'un tableau croisé dynamique.
Je voudrais éviter de faire A5 = rouge (comme j'avais fait auparavant) car comme le tableau peut changer de taille cela peut entrainer des erreurs, mais plutôt faire : si la cellule est un champs de colonne, la colorier en rouge.
Mais je ne sais pas comment faire celà ... Quelqu'un pourrait-il m'aider ?

Merci :)
 
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Macro Excel TCD

Bonjour,

Bonjour Job :)

Effectivement, ça se voit à l'œil nu, mais comme il (elle) voudrait les colorier...

@ groota

essaie ce code (à adapter avec ton nom de tableau, et de champ..)

Code: 
Dim Pvt As PivotItem
For Each Pvt In ActiveSheet.PivotTables("nom_du_TCD").PivotFields("nom_du_champ").PivotItems
    Pvt.LabelRange.Interior.ColorIndex = 6
Next Pvt

Bonne journée
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Macro Excel TCD

Re-,

avec ce code, tu mets en jaune les totaux, et en rouge le total général..

Noms à adapter...

Code: 
Sub color_item()
Dim Pvt1 As PivotItem, Pvt2 As PivotItem
Dim Lig As Integer, Col As Byte
On Error Resume Next
For Each Pvt1 In ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("nb").PivotItems
    If Pvt1.Visible = True Then
        Col = Pvt1.LabelRange.Column
        Pvt1.LabelRange.Offset(Pvt1.DataRange.Count + 1, 0).Interior.ColorIndex = 6
    End If
Next Pvt1
For Each Pvt2 In ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("date").PivotItems
    If Pvt2.Visible = True Then
        Lig = Pvt2.LabelRange.Row
        Pvt2.LabelRange.Offset(0, Pvt2.DataRange.Count + 1).Interior.ColorIndex = 6
    End If
Next Pvt2
Cells(Lig + 1, Col + 1).Interior.ColorIndex = 3
End Sub
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Macro Excel TCD

Bonjour,

pour le moment, je travaillais en aveugle...

Si tu veux qu'on progresse dans ton projet, il serait préférable que tu joignes un ersatz de fichier, avec des données bidons, mais avec la structure exacte..

Le plus simple, tu prends ton fichier réel, tu en fais une copie, tu gardes une vingtaine ou trentaine de lignes, tu remplaces tous les e par une autre lettre, tous les p par une autre, par exemple, autant de lettres que tu veux, ainsi il sera plus aisé de t'aider.

Ne garde que l'onglet qui nous intéresse....

A te relire
 
Vote positif 0 Vote négatif
G

groota

XLDnaute Nouveau
Re : Macro Excel TCD

Regarde la pièce jointe Ersatz2.xls

Je ne sais pas si la macro va avec, donc dans le doute, je la recopie :

Code: 
Sub Capacité()
'
' Capacité Macro
' Macro enregistrée le 16/06/2009 par Moi
'
' Touche de raccourci du clavier: Ctrl+Maj+C

'Préparation du TCD
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!A:K").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
Array("Capacité"), ColumnFields:="Lieux", PageFields:= _
Array("Année", "Mois", "Jour", "Heure")
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Papiers"). _
Orientation = xlDataField
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "", _
xlDataAndLabel, True
'Fin de la préparation du TCD

'Mise en page

'Masquer la ligne et la colonne vides :
    Range("A11").Select
    Selection.Delete

Range("A1,A2,A3,A4,A6,A7,B6").Select
Selection.Interior.ColorIndex = 2
Selection.Font.FontStyle = "Gras"
Selection.Font.Size = 9

Range("A6,A7").Select
Selection.HorizontalAlignment = xlCenter
 

'Mettre en violet les 2 lignes  
Range("B7,C7,D7,E7,F7,A11,B11,C11,D11,E11,F11").Select
Selection.Interior.ColorIndex = 24
Selection.Font.ColorIndex = 55
Selection.Font.FontStyle = "Gras"
Selection.HorizontalAlignment = xlCenter

Range("F8:F10").Select
Selection.Font.FontStyle = "Gras"
Selection.HorizontalAlignment = xlCenter

Range("A8:E10").Select
Selection.HorizontalAlignment = xlCenter

Range("A8:A10,F8:F10,B8:E10").Select
Selection.Interior.ColorIndex = 2


Range("A11,B11,C11,D11,E11,F11").Select
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThick
    .ColorIndex = 55
End With

'Mettre "Année", "Mois", "Jour" et "Heure" dans l'ordre
    Range("A4").Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Année")
        .Orientation = xlPageField
        .Position = 4
    End With
    Range("A4").Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Mois")
        .Orientation = xlPageField
        .Position = 3
    End With
    Range("A4").Select
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Jour")
        .Orientation = xlPageField
        .Position = 2
    End With
    
'Créer le graphique
Charts.Add
    ActiveChart.SetSourceData Source:=Sheets("Feuil1").Range("B10")
    ActiveChart.Location Where:=xlLocationAsNewSheet
    ActiveChart.PlotArea.Select
    Selection.Border.ColorIndex = 16
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
    End With
    ActiveChart.ChartType = xlColumnClustered
    On Error Resume Next
    ActiveChart.SeriesCollection(2).Interior.ColorIndex = 24
    ActiveChart.SeriesCollection(3).Interior.ColorIndex = 20
    ActiveChart.SeriesCollection(4).Interior.ColorIndex = 37
End Sub

Voilà :)

ps : J'ai deux tableaux et deux graphiques dans ma macro normalement. Là j'en ai mis qu'un pour ne pas compliquer ... :p
 
Dernière édition:
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Re : Macro Excel TCD

Re-,

quand je vois ce que fait ta macro, je ne pourrai que te conseiller de regarder les types de TCD qu'offre Excel....

Clique dans le TCD, n'importe où...

Dans la barre d'outils "Tableau Croisé Dynamique", clique sur le 2 ème bouton (qui représente un tableau avec un éclair....)

Et essaie..

Une fois que tu as trouvé ton bonheur, remets l'enregistreur de macro en chauffe....

Si tu ne le trouves pas, tu voudrais que j'insère mon code dans le tien?

J'attends ta réponse avant de commencer à travailler...

Bon courage
 
Vote positif 0 Vote négatif
G

groota

XLDnaute Nouveau
Re : Macro Excel TCD

Bin justement au début j'avais fait ça ... j'avais utilisé l'enregistreur et pris les machins de excel, mais je trouvais pas ça super le résultat ...


"quand je vois ce que fait ta macro, je ne pourrai que te conseiller de regarder les types de TCD qu'offre Excel...."
---> ça veut dire que tu trouves ça moche mon truc ?
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
XL 2021 TCD
Réponses
0
Affichages
217
Louis57852
L
C
  • Résolu(e)
XL 2016 Problème de TCD avec Champ Date
Réponses
11
Affichages
462
chris
chris
G
  • Question
XL 2016 Lier un TCD et un tableau Excel
Réponses
7
Affichages
318
OKBI
O
V
  • Question
XL 2016 Pouvoir faire un tableau dynamique croisé avec des données en ligne
Réponses
13
Affichages
553
vivi21
V
D
  • Question
Microsoft 365 combiner deux plages de données sur deux feuilles excel différentes pour un TCD
Réponses
4
Affichages
269
Daniel200666
D
M
  • Question
Microsoft 365 TCD et GCD - Elaboration de tableau de bords EXCEL 365
Réponses
2
Affichages
138
merinos
merinos
M
  • Question
XL 2021 Mise en Forme Conditionnelle avec Formule Complexe
Réponses
4
Affichages
275
sylvanu
sylvanu
Roseline
  • Résolu(e)
Microsoft 365 Débloquer une cellule selon un autre en VBA
Réponses
7
Affichages
280
Roseline
Roseline
L
  • Question
Microsoft 365 Valeur arrondie dans TCD
Réponses
3
Affichages
598
xUpsilon
xUpsilon
J
  • Question
XL 2019 Filtrage des données dans un TCD
Réponses
10
Affichages
281
Cousinhub
Cousinhub

Membres actuellement en ligne

15 membres et 266 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 595
Messages
2 090 104
Membres
104 378
dernier inscrit
neovo