XL 2019 VBA - Simplifier un code fait par enregistrement

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion ruliann
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
R

ruliann

XLDnaute Occasionnel
bonjour,

Je suis en train de réaliser un graph en anneau sur le fichier ci-joint. J'ai réalisé ce graph en suivant ce tuto et j'aimerais simplifier l'étape fastidieuse du coloriage de chacun des segments...



2022-10-09_11h02_01.png





Chacun des 8 anneaux est divisé en 96 segments, et chacun de ces segments sera colorié selon une suite de 8 couleurs : rouge / orange/orange clair / jaune..../ blanc.

2022-10-09_10h52_12.png



Alors j'ai testé la fonction enregistrement de macro pour le coloriage "en rouge" du 1er anneau, ce qui me donne le code ci-dessous. Le code fonctionne mais est fastidieux à modifier.

Je n'y connais rien en VBA mais j'ai envie d'apprendre. Je pense que la logique VBA voudrait que je fasse une boucle sur les 96 segments du 1er anneau ActiveChart.FullSeriesCollection(1), que le point 1 soit colorié en rouge, puis le point1+8 (soit le point 9) soit colorié en rouge lui aussi, puis le point9+8 (soit le point 17) soit colorié en rouge, etc....jusqu'au point 12.

Je ne sais pas comment initié la boucle et intégrer la ou les variables. Sauriez-vous me guider?


VB: 
Sub Anneau1_color1()
'
' Anneau1_color1 Macro
'

'
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(2).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(3).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(4).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(5).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(6).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(7).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(8).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(9).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(10).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(11).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(12).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(13).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(14).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(15).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(16).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(17).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(18).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(19).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(20).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(21).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(22).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(23).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(24).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(25).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(26).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(27).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(28).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(29).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(30).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(31).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(32).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(33).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(34).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(35).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(36).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(37).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(38).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(39).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(40).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(41).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(42).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(43).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(44).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(45).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(46).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(47).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(48).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(49).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(50).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(51).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(52).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(53).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(54).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(55).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(56).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(57).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(58).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(59).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(60).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(61).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(62).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(63).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(64).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(65).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(66).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(67).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(68).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(69).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(70).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(71).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(72).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(73).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(74).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(75).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(76).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(77).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(78).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(79).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(80).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(81).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(82).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(81).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(82).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(83).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(84).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(85).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(86).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(87).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(88).Select
    ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(1).Points(89).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Solid
    End With
End Sub
 

Pièces jointes

Dernière édition:
Solution
Staple1600
Bonjour @ruliann , le fil

Pour ce qui est du graphique
VB: 
Sub Colorer_Graphique_C()
Dim i&, j&
Application.ScreenUpdating = False
With ActiveSheet.ChartObjects("Graphique 1").Chart
    For j = 1 To 8
            For i = 1 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(23, "B").Interior.Color
            Next i
            For i = 2 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(24, "B").Interior.Color
            Next i
            For i = 3 To 96 Step 8
                .FullSeriesCollection(j).Points(i).Format.Fill.ForeColor.RGB = Cells(25, "B").Interior.Color
            Next i
            For i = 4 To 96 Step 8...
Trier par date Trier par votes
Staple1600 à dit:
Bonjour @ruliann , le fil

C'est pas mal comme simplification, non ? 😉
VB: 
Sub Colorer_Tableaux()
For Each c In Range("A1:H15")
c.Interior.Color = Cells(Array(23, 24, 25, 26, 27, 28, 29)(c.Value - 1), 2).Interior.Color
Next
End Sub
NB: Test OK
(attention pas de cellule vide en A1:H15 et uniquement des valeurs de 1 à 7)
Cliquez pour agrandir...
je comprends pas le (c.Value - 1), 2) ? ca veut dire quoi?
 
Vote positif 0 Vote négatif
Bonjour @ruliann

1 ) Est-ce plus clair avec cet exemple ?
VB: 
Sub Explications()
For i = 0 To 6
MsgBox Cells(Array(23, 24, 25, 26, 27, 28, 29)(i), 2).Address & " | i= " & i
Next
'le pourquoi du -1
For k = 1 To 7
MsgBox Cells(Array(23, 24, 25, 26, 27, 28, 29)(k - 1), 2).Address & " | k= " & k
Next
End Sub
2) Que penses-tu de mon code allégé ?
Il fait ce qu'il doit faire ?
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Bonjour @ruliann

1 ) Est-ce plus clair avec cet exemple ?
VB: 
Sub Explications()
For i = 0 To 6
MsgBox Cells(Array(23, 24, 25, 26, 27, 28, 29)(i), 2).Address & " | i= " & i
Next
'le pourquoi du -1
For k = 1 To 7
MsgBox Cells(Array(23, 24, 25, 26, 27, 28, 29)(k - 1), 2).Address & " | k= " & k
Next
End Sub
2) Que penses-tu de mon code allégé ?
Il fait ce qu'il doit faire ?
Cliquez pour agrandir...
merci pour l'explication 👍
pour le moment je rencontre une difficulté avec ton dernier code, alors je cherche d'où ca peut venir :
2022-10-19_15h16_39.png
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

J
  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
242
jalaba
J
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
244
patricktoulon
patricktoulon
B
  • Question Question
XL 2019 Dans une macro de démarrage de fichier masquer le code par des Astérix ou point
Réponses
3
Affichages
110
sylvanu
sylvanu
G
  • Question Question
XL 2010 Modifier couleur de texte de zonetexte par vba
Réponses
3
Affichages
87
patricktoulon
patricktoulon
K
  • Question Question
XL 2016 Insérer Graph Excel dans Powerpoint VBA
Réponses
1
Affichages
671
Zon
Z
oguruma
EXCEL :: VBA :: Barre de progression via un graphique cylindrique, cubique, aquarium, donuts et shape
Réponses
0
Affichages
84
oguruma
oguruma
A
  • Résolu(e)
Microsoft 365 VBA filtre erreur si pas la condition
Réponses
3
Affichages
83
Ang3lina
A
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
489
Chaton77
Chaton77
G
  • Question Question
XL 2016 # MFC applicable selon valeur autre cellule Vba
Réponses
9
Affichages
505
TooFatBoy
TooFatBoy
N
  • Question Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
435
Phil69970
Phil69970
M
  • Question Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
655
marie3107
M
D
  • Question Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
979
Dudy
D
B
  • Question Question
Microsoft 365 Titre axe d'un graphique
Réponses
10
Affichages
1 K
Batourouciss
B
S
  • Question Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
387
souhaib ad
S
M
  • Résolu(e)
XL 2010 Code VBA pour Appeler un onglet avec texte + variable
Réponses
9
Affichages
838
Phil69970
Phil69970
Heodrene
  • Question Question
Microsoft 365 Procédure appelée depuis une procédure qui ne s'éxécute pas totalement
Réponses
12
Affichages
1 K
Dranreb
Dranreb
S
  • Question Question
XL 2021 macro VBA excel
Réponses
1
Affichages
475
crocrocro
C
M
  • Question Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
426
Gégé-45550
Gégé-45550
T
  • Résolu(e)
XL 2019 Filtrer certains champs au démarrage avec vba
2
Réponses
15
Affichages
233
telemarrk
T
N
  • Résolu(e)
XL 2021 erreur Vba
2
Réponses
21
Affichages
2 K
Oneida
Oneida
Retour