Bonjour à tous,

Je dois faire un tableau croisé dynamique (TCD) en VBA à partir de la feuille "synthèse" du classeur dont je joins le lien.

http://cjoint.com/?0Brl0FPvyfN

J'ai contruit une macro et je souhaiterais coloriser les champs en fonction des valeurs de la base :

en vert pour les cas suivants

:

1 - Réussite en 4 trim 1 - Réussite en 5 trim 1 - Réussite en 6 trim

en orange pour le cas ci-dessous

2- autre cas de réussite

La macro fonctionne si toutes ces valeurs sont présentes dans la base. (onglet .Synthèse avec toutes valeurs)

Mais, si par hasard la dernière valeur ne figurait pas (2- autre cas de réussite ) les codes couleurs ne marchent plus et une couleur orange apparait pour les autres cas de réussite :

(voir l'onglet "TCD-effectifs"), généré à partir de la feuille synthèse dans laquelle il manque la valeur 2- autre cas de réussite.

je pense que j'ai un problème de type gestion d'erreur

ci-dessous le code VBA

Sub I_TCD_Effectifs()

Application.DisplayAlerts = False 'suppression de la feuille "TCD_Effectifs" si elle existe
For Each x In Sheets
If x.Name = "TCD_Effectifs" Then x.Delete
Next
Application.DisplayAlerts = True

Sheets("Synthèse").Select
Cells(1, 1).Select

Selection.CurrentRegion.Select

ActiveWorkbook.Names.Add Name:="basetcd", RefersToR1C1:= _
"=OFFSET(Synthèse!R1C1,0,0,COUNTA(Synthèse!C1),COUNTA(Synthèse!R1))"

Sheets.Add
ActiveSheet.Name = "TCD_Effectifs"
Range("A1").Select

On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.PivotTables("tcd_effectifs").TableRange2.Clear

Sheets("Synthèse").Select 'création tcd

Selection.CurrentRegion.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"basetcd", Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
:="TCD_Effectifs!R1C1", TableName:="tcd_effectifs", _
DefaultVersion:=xlPivotTableVersion14
Sheets("TCD_Effectifs").Select
Cells(1, 1).Select

With ActiveSheet.PivotTables("tcd_effectifs")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With

With ActiveSheet.PivotTables("tcd_effectifs").PivotFields( _
"Résultat du parcours")
.Orientation = xlRowField
.Position = 1
End With

ActiveSheet.PivotTables("tcd_effectifs").AddDataField ActiveSheet. _
PivotTables("tcd_effectifs").PivotFields("Matricule"), _
"Nombre de Matricule", xlCount
With ActiveSheet.PivotTables("tcd_effectifs").PivotFields("Année de cohorte")
.Orientation = xlColumnField
.Position = 1
End With







'suppression des totaux généraux
ActiveSheet.PivotTables("tcd_effectifs").RowGrand = False
ActiveSheet.PivotTables("tcd_effectifs").ColumnGrand = False

'colorisation réussite

On Error Resume Next
Sheets("TCD_Effectifs").Select

ActiveSheet.PivotTables("tcd_effectifs").PivotSelect "'1 - Réussite en 4 trim'", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With

ActiveSheet.PivotTables("tcd_effectifs").PivotSelect "'1 - Réussite en 5 trim'", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0


End With

ActiveSheet.PivotTables("tcd_effectifs").PivotSelect "'1 - Réussite en 6 trim'", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With

ActiveSheet.PivotTables("tcd_effectifs").PivotSelect "'2- autre cas de réussite'", _
xlDataAndLabel, True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
gesterreur:
'classeur vide
If Err.Number = -2147221080 Then
Resume Next
End If

'encadrement et alignement du TCD

ActiveSheet.PivotTables("tcd_effectifs").PivotSelect "", xlDataAndLabel, True

With Selection
With .Font
.Name = "Arial"
.Size = 9
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With


Range("a1").Select



End Sub

Merci de votre aide

Bonsoir,

Sub I_TCD_Effectifs()
Application.DisplayAlerts = False
For Each x In Sheets
If x.Name = "TCD_Effectifs" Then x.Delete
Next
Application.DisplayAlerts = True
Sheets("Synthèse").Activate
Sheets.Add
ActiveSheet.Name = "TCD_Effectifs"
Range("A1").Select
On Error Resume Next
ActiveWorkbook.PivotCaches.Create(xlDatabase, "basetcd", 4) _
.CreatePivotTable "TCD_Effectifs!R1C1", "tcd_effectifs", , 4
With Sheets("TCD_Effectifs").PivotTables("tcd_effectifs")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
With .PivotFields("Résultat du parcours")
.Orientation = xlRowField
.Position = 1
End With
.AddDataField ActiveSheet.PivotTables("tcd_effectifs").PivotFields("Matricule"), _
"Nombre de Matricule", xlCount
.RowGrand = False
.ColumnGrand = False
For Each c In .RowRange
rtcd = c.Value
.PivotSelect rtcd, xlDataAndLabel, True
With Selection.Interior
If rtcd Like "1*" Then
.Color = RGB(146, 208, 80)
ElseIf rtcd Like "2*" Then
.Color = RGB(255, 192, 0)
End If
End With
Next c
.PivotSelect "", xlDataAndLabel, True
With Selection
With .Font
.Name = "Arial"
.Size = 9
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
End With
Sheets("TCD_Effectifs").Activate
Range("a1").Select
End Sub

J'ai pas mal hésité à me lancer, je trouve les fragments d'enregistrements de macro particulièrement indigestes et à l'opposé d'une programmation rationnelle. Je te renvoie à mes remarques lors d'un précédent sujet...

De plus je ne suis pas du tout familier des TCD !

Cependant, comme ton erreur était patente, cela m'a entraîné à rechercher une solution...

Tu avais placé un gestionnaire d'erreur au milieu de ta macro ! On le place à la fin pour ne pas perturber l'exécution du code. Et avant l'étiquette de branchement sur le gestionnaire on place un : Exit Sub pour éviter de "gérer" une erreur inexistante en fin de macro. Cela aurait pu avoir des effets complètement imprévus si ce gestionnaire n'avait été complètement inopérant !

En effet, pour que le gestionnaire soit actif, il faut qu'en début de macro ou à un emplacement judicieusement choisi figure l'instruction : On Error GoTo xxx (xxx étant l'étiquette de branchement). Or tu as placé comme instruction : On Error Resume Next (même deux fois mais une suffit largement) qui aboutit de fait à ignorer toute erreur d'exécution survenant dans le déroulement de la macro.

Donc lorsque tu utilises la méthode PivotSelect pour sélectionner une ligne qui n'existe pas dans le TCD, une erreur se produit, qui n'arrête pas l'exécution laquelle se poursuit en affectant la couleur orange à la sélection précédente qui n'a pas été modifiée.

Hormis ce problème, il serait préférable de placer la macro dans un module standard (et réserver le module ThisWorkbook aux évènements de classeur). Je rappelle aussi qu'il n'est pas inutile de déclarer les variables (ce que je n'ai pas fait ici ! ), cela peut éviter des résultats inattendus et cela améliore le fonctionnement. J'ai noté aussi que tu désactivais l'affichage, c'est parfois ou même souvent utile, mais antinomique avec toute la série de sélections qui suit ! De plus, quand on désactive, il ne faut pas oublier de réactiver.

On devrait pouvoir faire mieux pour cette macro mais cela exige une connaissance approfondie du modèle objet en ce qui concerne les TCD, ce qui n'est pas mon cas.

Bonjour Ferrand

Je te remercie encore une fois !

J'étais sûr que l'on se retrouverait ; (cf mon dernier post https://forum.pcastuces.com/macro_vba_valeur_maximale-f23s33384.htm?page=1&#4937555)

Il est vrai que depuis je n'ai pas investi dans un ouvrage VBA même si je suis allé voir les contenus que tu m'avais indiqués.

Pour l'instant je suis dans une phase où je me dois d'être efficace au risque d'appliquer des contenus indigestes pour reprendre ton expression de l'enregistreur de macro.

Par contre j'ai du mal à comprendre ton observation sur l'affichage

"J'ai noté aussi que tu désactivais l'affichage, c'est parfois ou même souvent utile, mais antinomique avec toute la série de sélections qui suit ! De plus, quand on désactive, il ne faut pas oublier de réactiver."

peux tu m'indiquer où était cette ligne dans mon précédent code ?

Je t'en remercie et c'est toujours un plaisir (en tout cas pour moi ) d'échanger avec toi.

Très bonne journée.

Bonjour,

Regarde dans ton code reproduit dans ton post initial, le début qui suit la suppression de la feuille accueillant le TCD, passage que j'ai supprimé presque en entier... :

Sheets("Synthèse").Select 'J'ai conservé l'activation car l'ajout qui vient ensuite se fait par défaut avant la feuille active si on ne précise pas
Cells(1, 1).Select

Selection.CurrentRegion.Select

ActiveWorkbook.Names.Add Name:="basetcd", RefersToR1C1:= _
"=OFFSET(Synthèse!R1C1,0,0,COUNTA(Synthèse!C1),COUNTA(Synthèse!R1))" 'Le nom demeure si tu ne supprimes pas la feuille Synthèse !

Sheets.Add
ActiveSheet.Name = "TCD_Effectifs"
Range("A1").Select

On Error Resume Next
Application.ScreenUpdating = False 'Voilà la désactivation de l'affichage...
ActiveSheet.PivotTables("tcd_effectifs").TableRange2.Clear 'Tu effaces un TCD qui n'existe pas encore sur la feuille que tu viens de créer

Sheets("Synthèse").Select

Selection.CurrentRegion.Select

Il n'y a pas plus loin réactivation (Application.ScreenUpdating = True). Mais quand tu actives ou sélectionnes ensuite des éléments graphiques, cela suppose que l'affichage soit actif pour que l'opération soit possible. De toute façon, ce n'était pas appliqué lors de l'exécution de ta macro, je n'ai pas déterminé exactement la raison... Ce qui est en rouge a été supprimé.

Note que dans la macro réécrite, tu peux encore supprimer à la fin l'activation de la feuille TCD, inutile car elle est déjà active. Les sélections précédentes d'éléments du TCD qui s'y trouve l'ont nécessairement rendue active.

Modifié par ferrand le 18/02/2014 09:37

Bonjour Ferrand,

un grand merci pour tes explications !

Je serai vigilant et surtout j'espère avoir le temps d'apprendre ce "langage" sans brûler les étapes !

A bientôt !