Discussion :

[Globetruck]

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.

[tamtam64]

Fais un pas a pas pour cerner le problème et dis nous ce que ca donne, c'est peut etre par la , avec des boucles , mais dis nous.

Code :

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

1
2
3
4
5
6
7
8
9
10
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

[Globetruck]

Merci de la réponse mais le problème n'est pas là. Cette loop sert à déterminer où je part dans mes données. Je veux partir à 00h15. Lorsque j'ai une différence entre les dates, c'est que j'ai changé de journée et c'est là que je pars pour avoir des journées complètes de 00h05 à 24h00

C'est à partir de la ligne 165 que les problèmes arrives. Le modérateur a ajouter mon code dans une bulle code est c'est très bien (j'ai oublié de le faire) mais il aurait fallu diviser en deux cette bulle. J'ai refait le tout est c'est plus clair. C'est vraiment lorsque je veux ajouter les entêtes et pieds de pages. Je suis certains que mon problème est dans l'optimisation de ma boucle car tout marchait en Excel 2003 mais ça marche plus en Excel 2010. Merci de votre aide car je suis un peu découragé.

[Theze]

Bonjour,

As-tu essayé en supprimant les Select ? Car même avec un gel de l'écran la sélection est gourmande surtout avec ton "Charts.Select" :

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
 
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")
 
 
    For i = 1 To Charts.Count
 
        With Charts(i).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

Hervé.

[Globetruck]

Bonjour,

J'ai effectivement refait un bout de programme et j'ai gagné un peu de vitesse (Merci beaucoup du commentaire) mais Excel gel toujours si je dépasse une boucle de plus de 6 graphiques.

J'arrive facilement à créer les 365 graphiques avec la macro de création de graphique. Mais la mise en page...je n'y arrive pas pourtant Excel XP ou 2007 y arrivait facilement.

Voici mon code de mise en page modifié mais toujours problématique:

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
Sub miseenpage()
 
Dim nomclient
Dim nosga
Dim graphecourant As Chart
 
 
Set parametres = Worksheets("Paramètres")
nomclient = parametres.Range("F1").Value
nosga = parametres.Range("F2").Value
 
' Save the current state of Excel settings.
screenUpdateState = Application.ScreenUpdating
statusBarState = Application.DisplayStatusBar
calcState = Application.Calculation
eventsState = Application.EnableEvents
' Note: this is a sheet-level setting.
'displayPageBreakState = ActiveSheet.DisplayPageBreaks
 
' Turn off Excel functionality to improve performance.
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
' Note: this is a sheet-level setting.
 
 
  For i = 1 To Charts.Count
 
 
    With Charts(i).PageSetup
        .LeftFooter = nomclient
        .CenterFooter = "N° contrat: " & nosga
        .RightFooter = "Page  &p"
        .ChartSize = xlFullPage
        .CenterHorizontally = True
        .CenterVertically = True
        .Orientation = xlLandscape
        .FirstPageNumber = xlAutomatic
        .Zoom = 100
    End With
 
Next i
 
' Restore Excel settings to original state.
Application.ScreenUpdating = screenUpdateState
Application.DisplayStatusBar = statusBarState
Application.Calculation = calcState
Application.EnableEvents = eventsState
' Note: this is a sheet-level setting
'ActiveSheet.DisplayPageBreaks = displayPageBreaksState
 
End Sub

J'ai inséré un msgbox(i) dans ma boucle pour connaître le temps d'une loop. Résultat: 10 secondes pour faire une loop entre le for i et le next i. Donc, 60 minutes pour mettre en page 360 graphiques !

Si on prend ça d'un autre angle: Puis-je mettre en forme tout les graphiques d'un seul coup ou dois-je les passer un par un comme dans mon programme?

Est-ce que je pourrais me faire un modèle et mettre le tout en page lors de la création des graphiques?

La mise en page est simple: Ajouter un pied de page et ajuster la vue du graphique.

Ultimement, si je pouvais imprimer les graphiques dans un seul document PDF mise en page et ne rien stocker dans Excel, je serais OK.

Merci de votre aide car je ne sais plus où regarder.

[joe.levrai]

Bonjour,

et si tu effectuais la mise en page au fur et à mesure de la création des graphiques ?

par exemple, ta procédure miseenpage : tu lui ajoutes un argument "Graphique"

et à chaque tour de boucle qui crée les graphique, tu appelles la macro : miseenpage(LeGraphique)


y'a pas énorme à modifier pour tester, ça coute rien d'essayer ?