> Tous les forums > Forum Bureautique
 VBA TCD EXCEL (2007 ou 2010)Sujet résolu
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
WINNIE0931
  Posté le 17/02/2014 @ 11:55 
Aller en bas de la page 
Petit astucien

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

Publicité
ferrand
 Posté le 18/02/2014 à 02:18 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

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.

WINNIE0931
 Posté le 18/02/2014 à 08:19 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

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.

ferrand
 Posté le 18/02/2014 à 09:35 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
  Astucien

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
WINNIE0931
 Posté le 18/02/2014 à 09:53 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Petit astucien

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 !

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
116,65 €SSD Corsair Force MP600 1 To (NMVe M.2 Gen4, 4950/4250 Mo/s) à 116,65 €
Valable jusqu'au 20 Mai

Amazon fait une promotion sur le SSD Corsair Force MP600 1 To (NMVe M.2 Gen4) qui passe à 116,65 € alors qu'on le trouve ailleurs à partir de 140 €. Ce SSD utilise une interface M.2 NVMe PCIe Gen4 x 4 pour une connexion simple et des performances exceptionnelles : jusqu’à 4950 Mo/s en lecture séquentielle et jusqu’à 4250 Mo/s en écriture séquentielle.

Le SSD est doté de la technologie 3D TLC NAND haute densité offrant une endurance d’écriture durable et assorti d’une garantie de 5 ans. Il est accompagné d'un dissipateur thermique.


> Voir l'offre
190,75 €Ecouteurs sans fil Apple AirPods Pro avec réduction active du bruit à 190,75 € livrés
Valable jusqu'au 19 Mai

Amazon Italie actuellement les écouteurs sans fil Apple AirPods Pro (2021) avec boîtier de charge sans fil à 185,90 € (avec la TVA ajustée). Comptez 4,85 € pour la livraison en France soit un total de à 190,75 € livrés. On les trouve ailleurs à 239 €.

 Les AirPods Pro signés Apple offrent une expérience audio supérieure en combinant Bluetooth 5.0, confort permanent, technologie de réduction de bruit active et une belle autonomie de 24 heures. Accompagnés d'un boîtier de charge sans fil, ils s'inviteront idéalement dans votre quotidien.


> Voir l'offre
24,90 €Caméra de surveillance TP-Link Tapo C200 à 24,90 €
Valable jusqu'au 20 Mai

Amazon fait une promotion sur la caméra de surveillance TP-Link Tapo C200 qui passe à 24,90 €. On la trouve ailleurs autour d'une quarantaine d'euros. Cette caméra se connecte à votre réseau en WiFi et peut ensuite être contrôlée à distance. Elle offre une définition FullHD 1080p, la vision nocturne, la détection de mouvements (recevez une notification si quelque chose est détecté), une alarme sonore et visuelle. Le stockage se fait en local sur une carte MicroSD.


> Voir l'offre

Sujets relatifs
fichier Excel 2010 s'ouvre mal dans 2007
word 2003,2007,2010 et excel mêmes versions
Validation de données Excel 2010 vs 2007
menu contextuel excel 2007 ne fonctionne plus
Excel 2010
Excel 2010
Changement dans Excel 2010 ?
case à cocher dans cellule Excel 2010
Mise en forme conditionnelle Excel 2010
Extraction Excel 2010
Plus de sujets relatifs à VBA TCD EXCEL (2007 ou 2010)
 > Tous les forums > Forum Bureautique