Bonjour,
Je rencontre un problème dont je ne comprends pas l'origine.
Le classeur est un classeur xlsm.
La Feuille Interface contient un graphique et 2 groupes d'option (Formulaire) permettant de choisir la représentation des données en X et en Y.
Les données sont sur 4 feuilles (masquées):
La première feuille ne sert qu'à dessiner les limites.
Les 3 autres feuilles sont organisées de façon identique.
La mise à jour du graphique, en fonction des options sélectionnées, consiste juste à déplacer les plages de cellules source des série avec un offset, c'est-à-dire qu'il n'y a pas de calcul, juste 4 séries dont je modifie les adressses.

En vba, tous les objets publique sont déclarés et typés dans un module
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
Public Graphique As Chart
Public Interface As Worksheet, Limites As Worksheet
Public wkValidés As Worksheet, wkNouveaux As Worksheet, wkRejetés As Worksheet, wkTotal As Worksheet 'Feuilles contenant les données
Public srValidés As SeriesCollection, srNouveaux As SeriesCollection, srRejetés As SeriesCollection 'Séries du Graphique
Les objets sont initialisés à l'ouverture du classeur

Après clique sur une option, la fonction de mise à jour du graphique est appelée (dans la feuille Interface contenant les objets)
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Private Sub MiseAJourGraphique()
    MiseAJourLimitesGraphique
    MiseAJourSeriesGraphique
    MiseEnRougeDesPoints
End Sub
En fonction des options, les limites sont recalculées et mises à jours via des tableaux pour gagner du temps d'écriture (un calcul Worksheetfunction Min max, rien de terrible...)

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
Private Sub MiseAJourLimitesGraphique()
 
    Dim xMax As Range
    If OptionSérie Then offsetX = 1 Else If OptionDate Then offsetX = 2 'Note Objet OptionButton de la feuille Interface
    Set xMax = wkTotal.Range(wkTotal.Range("A2"), wkTotal.Range("A2").End(xlDown)).Offset(0, offsetX)
    Limites.Range("B2") = WorksheetFunction.Min(xMax) - 1 'Note: Objet Worksheet Public
    Limites.Range("B3") = WorksheetFunction.Max(xMax) + 1 'Note: Objet Worksheet Public
 
    If OptionValeur Then 'Note: Objet OptionButton de la feuille Interface
        offsetY = 3 'Note: variable Integer déclarée dans la Feuille Inteface
        With Limites 'Note: Objet Worksheet Public
            .Range("C2:C3") = Paramètre.Cible
            .Range("D2:D3") = Paramètre.Cible - Paramètre.StdDev
            .Range("E2:E3") = Paramètre.Cible - 2 * Paramètre.StdDev
            .Range("F2:F3") = Paramètre.Cible - 3 * Paramètre.StdDev
            .Range("G2:G3") = Paramètre.Cible + Paramètre.StdDev
            .Range("H2:H3") = Paramètre.Cible + 2 * Paramètre.StdDev
            .Range("I2:I3") = Paramètre.Cible + 3 * Paramètre.StdDev
        End With
 
    ElseIf OptionDS Then 'Note: Objet OptionButton de la feuille Interface
        offsetY = 4
        With Limites
            .Range("C2:C3") = 0
            .Range("D2:D3") = -1
            .Range("E2:E3") = -2
            .Range("F2:F3") = -3
            .Range("G2:G3") = 1
            .Range("H2:H3") = 2
            .Range("I2:I3") = 3
        End With
    End If
End Sub
La mise à jour des séries consiste à envoyer 3 paramètres textes à la fonction Mise à jour des séries
Les adresse des plages de cellules sont obtenues via des objets Range des objets publics WorkSheet et les variable du module (de la feuille) offsetX et offsetY.
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
40
Private Sub MiseAJourSeriesGraphique()
    Dim sr As Series, x$, y$
 
    'Pour les 3 jeux de série, vérification présence de données. Si oui, mise à jour, sinon delete la série
    With wkValidés
        If Not IsEmpty(.Range("A2")) Then
            x = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetX).Address
            y = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetY).Address
            CreationSerie "Validés", x, y
        Else
            On Error Resume Next
                Graphique.SeriesCollection("Validés").Delete
            On Error GoTo 0
        End If
    End With
    With wkNouveaux
        If Not IsEmpty(.Range("A2")) Then
            x = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetX).Address
            y = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetY).Address
            CreationSerie "Nouveaux", x, y
        Else
            On Error Resume Next
                Graphique.SeriesCollection("Nouveaux").Delete
            On Error GoTo 0
        End If
    End With
    With wkRejetés
        If Not IsEmpty(.Range("A2")) Then
            x = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetX).Address
            y = "=" & .Name & "!" & .Range(.Range("A2"), .Range("A2").End(xlDown)).Offset(0, offsetY).Address
            CreationSerie "Rejetés", x, y
        Else
            On Error Resume Next
                Graphique.SeriesCollection("Rejetés").Delete
            On Error GoTo 0
        End If
    End With
 
 
End Sub
Enfin, la mise à jours


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
Private Sub CreationSerie(Nom$, x$, y$)
    Dim sr As Series
    On Error Resume Next
        Set sr = Graphique.SeriesCollection(Nom)
    On Error GoTo 0
    If sr Is Nothing Then
        Set sr = Graphique.SeriesCollection.NewSeries
        With sr
            .Name = Nom
            .ChartType = xlXYScatter
            .XValues = x
            .Values = y
            Select Case Nom
                Case "Validés"
                    .MarkerStyle = xlMarkerStyleCircle
                    .MarkerBackgroundColor = vbGreen
                    .MarkerForegroundColor = vbGreen
                Case "Rejetés"
                    .MarkerStyle = xlMarkerStyleX
                    .MarkerForegroundColor = vbRed
                Case "Nouveaux"
                    .MarkerStyle = xlMarkerStyleCircle
                    .MarkerBackgroundColor = vbBlue
                    .MarkerForegroundColor = vbBlue
            End Select
        End With
    Else
        sr.XValues = x
        sr.Values = y
    End If
End Sub
Voila...
Tout semble propre.
Il y a peu de ligne.
Ça devrait tourner sans problème mais non!
Ça prends plus plusieurs minutes avec la roue qui s'affiche et Excel qui ne répond plus temporairement.
Au bout de quelque clics. Excel plante définitivement. C'est à n'y rien comprendre.
Une idée ???