Bonjour,

Je m'excuse à l'avance du long post mais je n'arrive pas à identifier ce qui me bloque dans ce programme.

J'ai 2 macros que j'utilise pour créer 1 graphique par jour avec des points au 15 minutes. La première macro produit donc 365 graphiques pour l'année. Cette macro fonctionne bien malgré que si vous avez des suggestions pour l'améliorer, je suis ouvert. Le problème est dans la seconde où la macro roule un peu et ensuite, Excel ne répond plus. On dirait que je manque de mémoire malgré que j'ai un ordi neuf en Win 7 et Excel 2010.

===============

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Sub tracer_graphique()
 
Application.ScreenUpdating = False
 
Dim nbgraphiquesparjour As Range
Dim nbjourscomplets As Range
Dim nbgraphiquestotals As Range
Dim intervales As Range
Dim indgraphe1 As Range
Dim indgraphe2 As Range
Dim puissancemax As Range
Dim nomclient As Range
Dim nosga As Range
Dim nbdonneesinter As Range
 
Set feuilledonnees = Worksheets("Données graphiques")
Set parametres = Worksheets("Paramètres")
Set nbgraphiquesparjour = parametres.Range("B1")
Set nbjourscomplets = parametres.Range("B2")
Set nbgraphiquestotals = parametres.Range("B3")
Set intervales = parametres.Range("B4")
Set indgraphe1 = parametres.Range("B5")
Set indgraphe2 = parametres.Range("B6")
Set puissancemax = parametres.Range("B7")
Set nomclient = parametres.Range("F1")
Set nosga = parametres.Range("F2")
Set nbdonneesinter = parametres.Range("B9")
indexfeuilledonnes = feuilledonnees.Index
 
'Demande du nombre de graphiques par jour
entreenbgraphiqueparjour = InputBox("Combien de graphiques par jour voulez-vous", "Nombre de graphique journalier", 1)
 
If entreenbgraphiqueparjour = "" Then
    Application.ScreenUpdating = True
    Exit Sub
End If
 
nbgraphiquesparjour.Value = entreenbgraphiqueparjour
 
feuilledonnees.Select
 
'Déterminons le nombre de jours complets et le départ
i = 1
premier = 0
nbjours = 0
 
Do While Cells(i, 1) <> 0
    If (Cells(i + 1, 1).Value - Cells(i, 1).Value) = 1 Then
        nbjours = nbjours + 1
        If premier < 1 Then
            ligneXdepart = Cells(i + 1, 4).Row
            premier = 2
        End If
    End If
i = i + 1
Loop
 
nbjourscomplets.Value = nbjours - 1
 
If nbgraphiquesparjour.Value <= 0 Then
    tttt = MsgBox("Le nombre de graphiques journaliers est inférieur ou égal à 0.", vbExclamation + vbOKOnly, "Erreur de compilation")
    Application.ScreenUpdating = True
    Exit Sub
ElseIf intervales <= 0 Then
    tttt = MsgBox("L'intervale de mesure est inférieur ou égal à 0.", vbExclamation + vbOKOnly, "Erreur de compilation")
    Application.ScreenUpdating = True
    Exit Sub
Else
 
nbdonnes = Round(24 * 60 / intervales.Value / nbgraphiquesparjour.Value, 0)
indexprecedant = indexfeuilledonnes + 1
End If
 
For j = 1 To nbgraphiquestotals
    feuilledonnees.Select
    colonneX = 2
    colonneY = 3
    If j > 1 Then
        ligneXdepart = ligneXfin + 1
    End If
    ligneXfin = (ligneXdepart + nbdonnes - 1)
    ligneYdepart = ligneXdepart
    ligneYfin = ligneXfin
    graphiquenom = "Profil de l'appel de puissance du " & Format(Cells(ligneXdepart, 1), "dddd, d mmmm yyyy") & Cells(ligneXdepart, colonneY + 2) & "  -  " & Format(Cells(ligneXdepart, colonneX), "hh:mm") & " à " & Format(Cells(ligneXfin, colonneX), "hh:mm")
    seriededonnes = Format(Cells(ligneXdepart, colonneX - 1), "yyyy-mm-dd") & "-Graphe " & j
    Range(Cells(ligneXdepart, colonneX), Cells(ligneYfin, colonneY)).Select
 
    Charts.Add
        With ActiveChart
            .Name = seriededonnes
            .ChartType = xlLine
            .Location Where:=xlLocationAsNewSheet
            .HasTitle = True
            .ChartTitle.Text = graphiquenom
            .Axes(xlCategory, xlPrimary).HasTitle = False
            .Axes(xlValue, xlPrimary).HasTitle = False
            .HasLegend = False
            .PlotArea.Interior.ColorIndex = xlNone
            .Move after:=Sheets(indexprecedant)
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Temps (heures)"
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Puissance (kW)"
        End With
    If j = 1 Then
        indgraphe1.Value = ActiveChart.Index
    ElseIf j = nbgraphiquestotals Then
        indgraphe2.Value = ActiveChart.Index
    End If
 
        With ActiveChart.Axes(xlCategory)
            .CrossesAt = 1
            .TickLabelSpacing = nbdonneesinter
            .TickMarkSpacing = nbdonneesinter
            .AxisBetweenCategories = True
            .ReversePlotOrder = False
            .TickLabels.Orientation = xlUpward
        End With
 
        With ActiveChart.Axes(xlValue)
            .MinimumScale = 0
            .MaximumScaleIsAuto = True
            .MinorUnitIsAuto = True
            .MajorUnitIsAuto = True
            .Crosses = xlAutomatic
            .ReversePlotOrder = False
            .ScaleType = xlLinear
            .DisplayUnit = xlNone
            .TickLabels.NumberFormat = "0.0"
        End With
 
        With ActiveChart.Axes(xlValue)
            .MinimumScale = 0
            .MaximumScale = puissancemax.Value
            .MinorUnitIsAuto = True
            .MajorUnitIsAuto = True
            .Crosses = xlAutomatic
            .ReversePlotOrder = False
            .ScaleType = xlLinear
            .DisplayUnit = xlNone
        End With
 
 
    ActiveChart.Deselect
    indexprecedant = indexprecedant + 1
Next j
parametres.Select
Application.ScreenUpdating = True
Charts(1).Select
 
OKmise = MsgBox("Voulez-vous ajouter les entêtes et pieds de pages avec les informations suivantes?" & Chr(10) & Chr(10) & "Nom du client: " & nomclient & Chr(10) & "No SGA: " & nosga, vbYesNo + vbExclamation, "Mise en page")
 
If OKmise = vbYes Then
    Application.Run ("miseenpage")
End If
Charts(1).Select
 
 
End Sub
============

Le problème provient de la mise en page par la suite que je rend conditionnel car elle demande beaucoup de temps (lent).

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
 
Sub miseenpage()
Application.ScreenUpdating = False
Dim nomclient As Range
Dim nosga As Range
 
Set parametres = Worksheets("Paramètres")
Set nomclient = parametres.Range("F1")
Set nosga = parametres.Range("F2")
 
 
Charts.Select
For i = 1 To Charts.Count
 
Charts(i).Select
 
    With ActiveChart.PageSetup
        .LeftFooter = nomclient.Value
        .CenterFooter = "N° contrat: " & nosga.Value
        .RightFooter = "Page  &p"
        .ChartSize = xlFullPage
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .FirstPageNumber = xlAutomatic
        .Zoom = 100
    End With
 
Next i
Application.ScreenUpdating = True
End Sub
Lorsque j'exécute cette macro, Excel devient gris après avoir fait quelques mise en page et c'est écrit: Excel ne répond pas.

Je doute que c'est la lenteur du tout qui cause cela mais tout fonctionnait bien en Office 2003. Je m'excuse du long post mais je voulais donner le plus d'information possible.

Merci de votre aide et bonne journée.