Discussion :

[meud007]

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 ???

[pgz]

Bonjour.

Tu as montré des lignes de déclarations d'objets, mais on ne voit pas de ligne d'instanciation comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set Limites = Thisworkbook.Worksheets("Limites")

Si tu veux comprendre ce qui se passe, ouvre dans l'éditeur VB la fenêtre d'exécution, la fenêtre d'espions et celle des variables locales et exécute au pas à pas (F8).

Bonne journée,

pgz

[meud007]

Voici le code d'instanciation qui est fait au moment de l'ouverture:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    Dim shGraphique As Shape
    On Error Resume Next
        Set shGraphique = Interface.Shapes("shGraphique")
        If shGraphique Is Nothing Then Set shGraphique = Interface.Shapes.AddChart: shGraphique.Name = "shGraphique"
    Set Graphique = shGraphique.Chart

La fonction AffecteFeuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub AffecteFeuille(Nom$, Obj As Object)
    Dim f As Worksheet
    On Error Resume Next
        Set f = Worksheets(Nom)
    On Error GoTo 0
    If f Is Nothing Then Set f = Worksheets.Add: f.Name = Nom
    Set Obj = f
End Sub

avec les appels du type

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

        AffecteFeuille "Interface", Interface

En mode débogage, aucune ligne ne plante. C'est juste la ressource.

[Invité]

Bonjour,
CE que veut dire pgz, c'est que tu ne fais pas de déinstanciation.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set myVariab=nothing

[meud007]

Bonjour,

Je veux que les variables Interface, Graphique, etc (celles que j'ai déclarées en public) restent affectées pendant toute l’exécution du programme pour ne pas avoir à les recharger.
J'ai bien essayé de remplacer ces lignes Interface.range("A1") par Worksheets("Interface").range("A1") pour ne plus avoir a utiliser ces variable, idem pour les variables de type Series, mais le problème ne vient pas de là.
Le code est toujours aussi lent.
Ça a marché un tout petit peu mieux avec un Application.ScreenUpdating en début et fin de la fonction MiseAJourGraphique, mais je pense que c'est encore autre chose.

[Invité]

D'abord tu uses et tu abuses du on error,sans en tirer profit!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if err<>0 then msgbox "n'existe pas !"

De plus il faut clearer les err

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

err.clear

si tu fais des boucles rendre la main à Windows de temps en temps pour l'autorise a gérer sa mémoire!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

doevents

Il est fortement conseillé d'utiliser des objets instanciés mais attention de ne pas changer la mémoire!

De plus tu peux inhiber les calculs; le rafraichissement d'écran; les événements Excel!

[Docmarti]

Bonjour meud007; Tous.

Tu pourrais utiliser la commande Timer au début et à la fin de tes différentes procédures pour savoir laquelle ralentit l'exécution.

Je vois que tu modifies des limites.
J'ai lu que Excel n'apprécie pas beaucoup que l'on change la valeur maximum de l'axe des X.

[pgz]

Re,

Autre piste : tu as des procédures évènementielles?

pgz

[meud007]

Merci à tous pour votre aide.

Je vais tacher de répondre aux différents points, et vous demander un peu d'indulgence car je suis entièrement autodidacte en programmation.
Le fond du problème est de transposer une interface graphique owc insérée dans un userform vers un classeur classique. En effet, le composant n'existe plus avec les nouvelles version d'office. Bref...

Le "On error resume next", suivi d'une ligne d'affectation d'objet, est la seule solution que j'ai trouvé pour vérifier l’existence d'un objet. S'il n'existe pas, il est créé. J'ai bien vu en mode débug que le "On error resume next" équivaut à un err.clear
Du coups, une seule ligne est présente entre les deux balise, et je sais forcément ce qui génère l'erreur.

Depuis hier, je me suis atteler à désinstancier les objets temporaire dans mon code, et fini par supprimer les objets Worksheets.

J'avais déjà essayé de bloquer les calculs et rafraichissement d'écran, sans effet notoire.

Je ne comprends pas pourquoi ces lignes de code ne passe pas. Je soupçonne un problème lié au graphique, et me demande si il ne vaut mieux pas le reconstruire entièrement à chaque mise à jour plutôt que de modifier les adresses des séries.

A terme, je voudrais pouvoir interagir entièrement avec mon graphique: zoomer, exclure, commenter des points, etc.