Bonjour,

Je vous fais part d'un problème d'exécution d'une macro VB qui met à jour un graphique et ajoute une étiquette de données avec mis en forme (Couleur).

Elle fonctionne bien en mode Débug via le pas à pas depuis F8.

Par contre en exécution directe, elle bug.

Les étiquettes s'affichent mais la mise en forme avec la modification des couleurs n'est pas prise en compte.

Sur une autre requête similaire, je n'ai même plus l'affichage des étiquettes qui se réalisent. (Voir la macro en exemple)

Si une personne à une idée sur ce problème merci d'avance

Exemple du code

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
Function EtiquetteParMois(ByVal NumMois As Byte)
Dim PositionPoints, i As Byte
Dim RVB As Long
'Application.ScreenUpdating = True
PositionPoints = 24 + NumMois 'Le TCD commence en 2017 M01 - 24 Points + Nb de Mois en 2019 à ajouter
'On Error Resume Next
    ActiveSheet.ChartObjects("Graphique 1").Activate
    ActiveChart.FullSeriesCollection(1).Select
 
For i = 1 To 3
 
    'ActiveChart.ChartArea.Select
    Worksheets("TCD(Par Mois)").ChartObjects("Graphique 1").Chart.FullSeriesCollection(i).DataLabels.Select
    Selection.Delete
    Worksheets("TCD(Par Mois)").ChartObjects("Graphique 1").Chart.FullSeriesCollection(i).Points(PositionPoints).Select
    Worksheets("TCD(Par Mois)").ChartObjects("Graphique 1").Chart.FullSeriesCollection(i).Points(PositionPoints).ApplyDataLabels Type:=xlShowValue
 
    Worksheets("TCD(Par Mois)").ChartObjects("Graphique 1").Chart.FullSeriesCollection(i).DataLabels.Select
    Worksheets("TCD(Par Mois)").ChartObjects("Graphique 1").Chart.FullSeriesCollection(i).Points(PositionPoints).DataLabel.Select
 
If i = 1 Then RVB = RGB(0, 112, 192)
If i = 2 Then RVB = RGB(255, 0, 0)
If i = 3 Then RVB = RGB(0, 128, 128)
 
    With Selection.Format.TextFrame2.TextRange.Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RVB
        .Transparency = 0
        .Solid
    End With
    Selection.Format.TextFrame2.TextRange.Font.Size = 10
Next i
 
End Function
 
Sub Test1()
EtiquetteParMois (5)
End Sub