sandrine1375
XLDnaute Nouveau
Bonjour à toutes et à tous,
J'ai créée une carte sous Excel dont je colore les régions selon des quartiles. Je souhaiterai au lieu de mettre une couleur unie, des motifs, c'est à dire des rayures de couleurs horizontales, verticales, ou des points.
Cela fonctionne bien mais le problème c'est que je génère sur la même carte d'autres cartes issues d'autres données qui utilisent la même méthode des quartiles. Aussi lorsque je demande de générer cette nouvelle carte avec une ventilation différente, les parties rayées restent rayées, comme si ma demande n'était pas prise en compte. Faut supprimer l'objet puis relancer la macro pour que cela fonctionne.
Ci-dessous le code SANS LES RAYURES
Ci-dessous la ligne que je met pour avoir mes rayures :
Comment et où mettre une ligne qui fais un refresh ou un clear afin que je puisse faire cela sans avoir a tout supprimer et renommer chaque objet pour chaque région SVP?!
Par avance merci
J'ai créée une carte sous Excel dont je colore les régions selon des quartiles. Je souhaiterai au lieu de mettre une couleur unie, des motifs, c'est à dire des rayures de couleurs horizontales, verticales, ou des points.
Cela fonctionne bien mais le problème c'est que je génère sur la même carte d'autres cartes issues d'autres données qui utilisent la même méthode des quartiles. Aussi lorsque je demande de générer cette nouvelle carte avec une ventilation différente, les parties rayées restent rayées, comme si ma demande n'était pas prise en compte. Faut supprimer l'objet puis relancer la macro pour que cela fonctionne.
Ci-dessous le code SANS LES RAYURES
Code:
Select Case UCase(Vcategorieindicateur)
Case 1
Vindicateur = 5
nomquartile4 = "< 300000 €"
nomquartile3 = "300000 € à 500000 €"
nomquartile2 = "500000 € à 750000 €"
nomquartile1 = "> 750000 €"
If Vcarte = 1 Then
MsgBox "Aucune donnée disponible pour cette période"
Exit Sub
End If
If Vcarte = 2 Then Vindicateur = Vindicateur - 2
If Vcarte = 2 Then
nomquartile4 = "< 300000 €"
nomquartile3 = "300000 € à 500000 €"
nomquartile2 = "500000 € à 750000 €"
nomquartile1 = "> 750000 €"
End If
Case 2
Vindicateur = 10
nomquartile4 = "< 25000 €"
nomquartile3 = "25001 € à 55000 €"
nomquartile2 = "55001 € à 80000 €"
nomquartile1 = "> 80000 €"
If Vcarte = 1 Then
MsgBox "Aucune donnée disponible pour cette période"
Exit Sub
End If
If Vcarte = 2 Then Vindicateur = Vindicateur - 2
If Vcarte = 2 Then
nomquartile4 = "< 25000 €"
nomquartile3 = "25001 € à 55000 €"
nomquartile2 = "55001 € à 80000 €"
nomquartile1 = "> 80000 €"
End If
End Select
Vnumeroligne = Worksheets("Feuil1").Range("D3").Value
Vannee = Worksheets("Feuil1").Range("C" & Vnumeroligne).Value
Worksheets("Evo encts CMSA").Select
Range("D4").Select
While ActiveCell.Value <> ""
Vcaisse = ActiveCell.Value
Vquartile1 = ActiveCell.Offset(0, Vindicateur).Value
Vquartile2 = ActiveCell.Offset(0, Vindicateur).Value
Vquartile3 = ActiveCell.Offset(0, Vindicateur).Value
Vquartile4 = ActiveCell.Offset(0, Vindicateur).Value
Vcolorquartile1 = 53
Vcolorquartile2 = 52
Vcolorquartile3 = 51
Vcolorquartile4 = 43
If Vquartile1 = "A" _
Then Worksheets("Carte" & Vannee).Shapes(Vcaisse).Fill.ForeColor.SchemeColor = Vcolorquartile1
If Vquartile1 = "A" _
Then Worksheets("Carte" & Vannee).Shapes("Rectangle 1").Fill.ForeColor.SchemeColor = Vcolorquartile1
If Vquartile2 = "B" _
Then Worksheets("Carte" & Vannee).Shapes(Vcaisse).Fill.ForeColor.SchemeColor = Vcolorquartile2
If Vquartile2 = "B" _
Then Worksheets("Carte" & Vannee).Shapes("Rectangle 2").Fill.ForeColor.SchemeColor = Vcolorquartile2
If Vquartile3 = "C" _
Then Worksheets("Carte" & Vannee).Shapes(Vcaisse).Fill.ForeColor.SchemeColor = Vcolorquartile3
If Vquartile3 = "C" _
Then Worksheets("Carte" & Vannee).Shapes("Rectangle 4").Fill.ForeColor.SchemeColor = Vcolorquartile3
Worksheets("Carte" & Vannee).Shapes("Rectangle 4").Visible = True
If Vquartile4 = "D" _
Then Worksheets("Carte" & Vannee).Shapes(Vcaisse).Fill.ForeColor.SchemeColor = Vcolorquartile4
If Vquartile4 = "D" _
Then Worksheets("Carte" & Vannee).Shapes("Rectangle 3").Fill.ForeColor.SchemeColor = Vcolorquartile4
Worksheets("Carte" & Vannee).Shapes("Rectangle 3").Visible = True
ActiveCell.Offset(1, 0).Select
WendCi-dessous la ligne que je met pour avoir mes rayures :
Code:
If Vquartile1 = "A" _
Then Worksheets("Carte" & Vannee).Shapes(Vcaisse).Fill.Patterned msoPatternDarkDownwardDiagonal
If Vquartile1 = "A" _
Then Worksheets("Carte" & Vannee).Shapes("Rectangle1").Fill.Patterned msoPatternDarkDownwardDiagonalComment et où mettre une ligne qui fais un refresh ou un clear afin que je puisse faire cela sans avoir a tout supprimer et renommer chaque objet pour chaque région SVP?!
Par avance merci
Dernière édition:
