Mise en page graphique EXCEL via VBA Excel ne répond plus !

Version imprimable

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:

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:

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.

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:

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

19/06/2015, 06h43
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é.

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:

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é.

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:

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.

22/06/2015, 17h24
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 ?

Merci, je viens de faire le test: Toujours le même problème et la tout gel à la création des graphiques. Le boucle suivante:
Code:

1 2 3 4 5 6 7 8 9 10 11 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
prend 10 secondes. Donc, 10 secondes x 365 graphiques / 60 sec = plus de 60 minutes !!!

Pourquoi ce code est si long ?

Merci.

22/06/2015, 21h59
clementmarcotte

Bonjour,

Sans rien promettre, mais, surtout si ton programme a été beaucoup zigonné, tu peux essayer de le traiter avec VBA Code Cleaner de Rob Bovey.

http://www.appspro.com/Utilities/CodeCleaner.htm
22/06/2015, 23h52
eriiic

Bonjour,

Pour les paramètres communs tu pourrais te créer un modèle et construire tes graphiques à partir de celui-ci.
Toujours ça de moins à faire ensuite et peut-être un gain de temps.

eric
23/06/2015, 16h12
Globetruck

Citation:

Envoyé par clementmarcotte

Bonjour,

Sans rien promettre, mais, surtout si ton programme a été beaucoup zigonné, tu peux essayer de le traiter avec VBA Code Cleaner de Rob Bovey.

http://www.appspro.com/Utilities/CodeCleaner.htm

Le clean-up est fait mais c'est toujours lent. Merci de la réponse.
23/06/2015, 16h17
Globetruck

Citation:

Envoyé par eriiic

Bonjour,

Pour les paramètres communs tu pourrais te créer un modèle et construire tes graphiques à partir de celui-ci.
Toujours ça de moins à faire ensuite et peut-être un gain de temps.

eric

Bonjour, je suis un peu amateur en code pour les modèles de graphiques et les appeler par la suite. Avez-vous un modèle ou un exemple pour me partir? J'ai fais des recherches sur le forum mais je trouve pas de réponses qui me permet de commencer mon code.

Merci de votre aide.
23/06/2015, 19h57
eriiic

Bonjour,

Tu choisis le graphique mis au point et dans le ruban : ' Enregistrer comme modèle'
Ensuite en enregistrement de macro tu insères un nouveau graphique 'tout type de graphique...' et tu vas le choisir dans le répertoire 'Modèle'.
Tu auras ce que tu as besoin dans la macro.

Attention si ton fichier est destiné à se balader le modèle sera uniquement sur ton micro. Il faudra le livrer avec.

eric
29/06/2015, 20h51
Globetruck

Bonjour,

Merci de votre aide et de l'idée de voir le problème autrement.

Après un test rapide, je ne gagne pas de vitesse et Excel ne répond pas, j'appelle 365 fois un modèle de graphique !!! Je suis pas mal découragé.

Merci de votre support.

Bonjour,

Désolé...
Tente la complète en optimisation :

Code:

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
    Dim screenUpdateState As Boolean, statusBarState As Boolean, eventsState As Boolean
    Dim calcState As Long
    Dim displayPageBreakState As Boolean, EnableFormatCalcState As Boolean, sheetCalcState As Long
    ' niveau Application
    With Application
        ' sauvegarder états et désactiver
        screenUpdateState = .ScreenUpdating
        .ScreenUpdating = False
        calcState = .Calculation
        .Calculation = xlCalculationManual
        statusBarState = .DisplayStatusBar
        .DisplayStatusBar = False
        'eventsState = .EnableEvents
        '.EnableEvents = False
    End With
    ' niveau Feuille
    With Sheets("Feuil1")
        ' saut de page
        displayPageBreakState = .DisplayPageBreaks
        .DisplayPageBreaks = False
        ' feuille avec données sources contenues dans des fichiers csv ou txt externes.
        sheetCalcState = .EnableCalculation
        .EnableCalculation = False
        ' 2007: calcul formats conditionnels
        EnableFormatCalcState = .EnableFormatConditionsCalculation
        .EnableFormatConditionsCalculation = False
    End With
    ' code
    ' ...
    ' Restaurer états.
    ' niveau Application
    With Application
        .ScreenUpdating = screenUpdateState
        .DisplayStatusBar = statusBarState
        .Calculation = calcState
        .EnableEvents = eventsState
    End With
    ' niveau Feuille
    With Sheets("Feuil1")
        .DisplayPageBreaks = displayPageBreakState
        ' feuille avec données sources contenues dans des fichiers csv ou txt externes.
        .EnableCalculation = sheetCalcState
        ' 2007: calcul formats conditionnels
        .EnableFormatConditionsCalculation = EnableFormatCalcState
    End With

Les calculs de saut de page sont souvent gourmands par exemple.
Compile de différentes pages de MS dont j'ai perdu les liens.
Et met aussi un DoEvents dans ta boucle pour être un peu moins bloqué...
A part ça pas d'autre idée que d'avoir de la monnaie pour la machine à café.

eric

30/06/2015, 17h48
Globetruck

Merci je fais le test et je vous reviens dès que possible. Devant de tel difficulté, j'ai fais testé mon matériel ce matin et j'ai un processeur défectueux qui fonctionne mais juste à 25% et cause des conflits dans Windows (une première pour moi car mes autres processeurs fonctionnaient ou fonctionnaient pas !!!). Je vais faire des tests sur mon computer personnel question d'éliminer toutes sources de problèmes matériels. Merci de votre aide.