Macro de construction d'un graphe composé

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour à tous,

Je débute dans les constructions de macro et je viens vous voir car j'ai un soucis.

J'ai des milliers de feuilles Excel du même type c'est-à-dire avec 8 colonnes de données dont 4 seulement sont utilisées pour tracer un graphe.
La première colonne est le temps, la deuxième et la troisième sont les températures et la huitième correspond au couple.

Les principaux soucis sont que le nombre de lignes n'est jamais le même, et le nom de fichier est toujours différent.

J'aimerais tracer un graphe Température (Axe des ordonnées de gauche) et Couple (Axe des ordonnées de droite) en fonction du Temps (Axe des abscisses) sur une nouvelle feuille du classeur.

En utilisant l'enregistrement de macro, voici le code généré:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Incrémental() ' ' Incrémental Macro ' ' Range("A:A,B:B,C:C,I:I").Select Range("I1").Activate ActiveSheet.Shapes.AddChart.Select ActiveChart.SetSourceData Source:=Range( _ "'Falex3999'!$A:$A;'Falex3999'!$B:$B;'Falex3999'!$C:$C;'Falex3999'!$I:$I") ActiveChart.ChartType = xlXYScatterSmoothNoMarkers ActiveChart.SeriesCollection(3).Select ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.SeriesCollection(3).AxisGroup = 2 ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.SeriesCollection(3).Select ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.ChartArea.Select ActiveChart.Location Where:=xlLocationAsNewSheet End Sub
J'aimerais donc généraliser ce code pour l'ensemble des fichiers et créer un graphe sur une feuille ayant toujours le même nom (ex:Graphe).

Merci d'avance pour votre aide ;)

Devour

26/05/2011, 10h54
mercatog

Bonjour
Tes fichiers sont dans un même dossier?
La feuille données a toujours le même nom?
26/05/2011, 11h05
Devour

Les fichiers sont classés par numéro:

Il y a différents dossiers qui répertorient 250 fichiers Excel, par exemple un dossier porte le nom "3000 à 3250", un autre le nom "3250 à 3500", etc...

Un nom de fichier est du type: "Falex3400.xls" et la feuille de données porte le nom Falex3400. Elle change donc constamment de nom.

Il y a donc des changements de noms et de dossiers suivant les numéros.
26/05/2011, 11h20
mercatog

Question 1:
La position de la feuille de données, est elle aussi en première position parmi les feuilles du classeur ou aussi aléatoire.

Question 2:
Tu as plusieurs dossiers, chaque dossier comporte plusieurs fichiers excel. c'est ça?

Comment, veux tu que le code sache quel dossier est le bon et à l'intérieur quel classeur est le bon?
26/05/2011, 11h25
Devour

En fait, les fichiers Excel sont générés par le logiciel Labview après un test numéroté sur une machine. Ces fichiers ne comporte qu'une seule feuille à l'intérieur portant le nom du fichier sans l'extension.

Après rangement des fichiers Excel dans les bons dossiers qui peuvent en contenir au maximum 250, j'aimerais réutiliser le logiciel Labview afin de contrôler la macro que je souhaite créer pour faire l'analyse des données sous forme d'un graphe.
26/05/2011, 11h38
mercatog

Tes dossiers 3000 à 3250", "3250 à 3500" ... sont rangés dans un même dossier père?
Le dossier père et les sous dossiers comportent t-ils autre chose que les fichiers utiles?
26/05/2011, 11h45
Devour

Ils sont dans un même dossier père, et tous les dossiers ne contiennent que des fichiers Excel.

Le fichier père porte le nom: "Files_Falex"

Pour un meilleur "visuel" sur les dossiers voici une image:
http://data.imagup.com/8/1121068526.JPG

Voilà

Crée un classeur vierge et y colle ce code.
Dans VBA éditeur, Outils>Références, coche la référence "Microsoft Scripting RunTime"
Adapte le nom du dossier père dans la sub Test.

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
Option Explicit
 
'Sub qui permet de tracer le graphique dans un classeur Wbk
 
Sub Incremental(Wbk As Workbook)
Dim Sh As Worksheet
Dim Grf As ChartObject
Dim Plage As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
'---------Au cas où une feuille Graphe existe déjà, on la supprime
On Error Resume Next
Application.DisplayAlerts = False
Wbk.Sheets("Graphe").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'-------------------------------------------------------------------
 
Set Sh = Wbk.Worksheets(1)
With Sh
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plage = Union(.Range("A1:C" & LastLig), .Range("I1:I" & LastLig))
    Set Grf = .ChartObjects.Add(0, 0, 600, 400)
    With Grf.Chart
        .SetSourceData Plage
        .ChartType = xlXYScatterSmoothNoMarkers
        .SeriesCollection(3).AxisGroup = 2
        .Location Where:=xlLocationAsNewSheet, Name:="Graphe"
    End With
End With
Set Grf = Nothing
Set Plage = Nothing
Set Sh = Nothing
End Sub
 
'###################################################
 
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Sub récursive qui permet de traiter tous les classeurs Excel commençant par Falex
'dans tous les sous dossiers xxxx à yyyy
 
Sub Traitement(Chemin As String)
Dim Fso As Scripting.FileSystemObject
Dim DossPere As Scripting.Folder
Dim DossFils As Scripting.Folder
Dim Fichier As Scripting.File
Dim Wbk As Workbook
 
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set DossPere = Fso.GetFolder(Chemin)
For Each Fichier In DossPere.Files
    If Fichier.Name Like "Falex*.xls*" Then
        Set Wbk = Workbooks.Open(Fichier.Name)
        Incremental Wbk
        Wbk.Close True
        Set Wbk = Nothing
    End If
Next Fichier
For Each DossFils In DossPere.subfolders
    If DossFils.Name Like "* à *" Then Traitement DossFils.Path
Next DossFils
Set Fso = Nothing
Set DossPere = Nothing
End Sub
 
'###################################################
 
'Sub de Lancement
 
Sub Test()
 
Application.ScreenUpdating = False
Traitement "C:\Users\user\Desktop" ' à adapter par rapport au dossier père de tous les dossiers à traiter
End Sub

PS: Commence par un échantillon restreint de fichiers.

Edit: Code modifié

26/05/2011, 12h25
Devour

Merci beaucoup pour ces réponses rapides Mercatog

J'ai donc essayé ton code sur un dossier que j'ai copié puis déplacer sur mon bureau et il me renvoie cette erreur là:

Citation:

Erreur d'exécution '1004':

'Falex4000.xls' introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.

Si vous essayer d'ouvrir le fichier à partir de la liste des fichiers les plus récents, assurez-vous que le fichier n'a pas été renommé, déplacé ou supprimé.

Erreur à cet endroit là:

Code:

Set Wbk = Workbooks.Open(Fichier.Name)

Mes fichiers commençaient bien au numéro 4000.

D'autre part, j'aimerais savoir si tu pouvais me montrer le code pour tracer le graphe seulement à l'intérieur d'une seule feuille, car ce que je compte faire, c'est donner un numéro de fichier ("ex:4130") dans LabVIEW afin qu'il lance Excel en arrière-plan et trace le graphe dans une nouvelle feuille. Labview devrait normalement s'occuper de trouver le fichier dans le bon dossier.

Effectivement, ci-joint codes modifiés (et optimisé). En effet j'avais fais les tests sur un seul dossier.

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
Option Explicit
 
'Sub qui permet de tracer le graphique dans un classeur Wbk
 
Sub Incremental(Wbk As Workbook)
Dim Sh As Worksheet
Dim Chrt As Chart
Dim Plage As Range
Dim LastLig As Long
 
Application.ScreenUpdating = False
'---------Au cas où une feuille Graphe existe déjà, on l'as supprime
On Error Resume Next
Application.DisplayAlerts = False
Wbk.Sheets("Graphe").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'-------------------------------------------------------------------
 
Set Sh = Wbk.Worksheets(1)
With Sh
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plage = Union(.Range("A1:C" & LastLig), .Range("I1:I" & LastLig))
    Set Chrt = Wbk.Charts.Add
    Chrt.Name = "Graphe"
    With Chrt
        .SetSourceData Plage
        .ChartType = xlXYScatterSmoothNoMarkers
        .SeriesCollection(3).AxisGroup = 2
    End With
    .Activate
End With
Set Chrt = Nothing
Set Plage = Nothing
Set Sh = Nothing
End Sub
 
'Nécessite d'activer la référence "Microsoft Scripting RunTime"
'Sub récursive qui permet de traiter tous les classeurs Excel commençant par Falex
'dans tous les sous dossiers xxxx à yyyy
 
Sub Traitement(Chemin As String)
Dim Fso As Scripting.FileSystemObject
Dim DossPere As Scripting.Folder
Dim DossFils As Scripting.Folder, DF As Scripting.Folder
Dim Fichier As Scripting.File
Dim Wbk As Workbook
 
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set DossPere = Fso.GetFolder(Chemin)
If DossPere.SubFolders.Count > 0 Then
    For Each DF In DossPere.SubFolders
        If DF.Name Like "* à *" Then
            For Each Fichier In DF.Files
                If Fichier.Name Like "Falex*.xls*" Then
                    Set Wbk = Workbooks.Open(DF.Path & "\" & Fichier.Name)
                    Incremental Wbk
                    Wbk.Close True
                    Set Wbk = Nothing
                End If
            Next Fichier
           'ICI seulement au cas ou chaque dossier a des sous dossiers
            For Each DossFils In DF.SubFolders
                If DossFils.Name Like "* à *" Then Traitement DossFils.Path
            Next DossFils
           'FIN
        End If
    Next DF
End If
Set Fso = Nothing
Set DossPere = Nothing
End Sub
 
'Sub de Lancement
 
Sub Test()
Dim t As Long
 
Application.ScreenUpdating = False
t = Timer
Traitement "C:\Users\user\Desktop"                                   ' à adapter par rapport au dossier père de tous les dossiers à traiter
MsgBox "Traitement terminé en " & Timer - t & " secondes"
End Sub

26/05/2011, 12h46
Devour

Cette fois-ci, il s'est arrêté ici:

Code:

.SeriesCollection(3).AxisGroup = 2

Et a fait ressortir l'erreur 1004 comme "Paramètre non valide"

De plus, dans le fichier, les nombres n'ont plus de virgules, elles ont été remplacé par des espaces.

Merci encore

PS: As-tu vu la fin de mon dernier message ? Pour constituer un graphe à l'intérieur d'un seul classeur.
26/05/2011, 13h00
mercatog

Merci de ne pas tirer la discussion par les cheveux.
Point par point et une seule question par sujet.

En principe, j'ai crée des fichiers tests selon la description que tu as fourni
Plusieurs fichiers avec une seule feuille (en A: temps, en B, C et I des valeurs numériques). Le séparateur décimal chez moi est le point.

J'ai nommé ces fichiers FalexNNNN.xls et je les ai mis dans des dossiers nommés XXXX à YYYY (dans un même dossier père: pour mon test c'était sur le bureau).

J'ai testé cette fois en lançant le code Test à partir d'un fichier vierge.
Le code parcourt tous les dossiers, parcourt tous les fichiers, ouvre ces fichiers un par un, crée le graphique dans une nouvelle feuille graphique appelé Graphe (selon ton code de ton premier message formalisé), Enregistre et ferme le fichier et passe au suivant.
26/05/2011, 14h17
Devour

4 pièce(s) jointe(s)

Moi aussi j'ai effectué un test avec des fichiers sur le bureau.

Voici les 4 fichiers en pièces jointes que j'ai placé dans le dossier "4000 à 4250" lui-même placé dans le dossier père "Files_Falex" localisé ici: "C:\Documents and Settings\User\Bureau\"

Après cela, j'ai créé la macro dans un fichier .xlsm vierge et il se passe ce que je t'ai dit au post précédent lorsque j'exécute cette macro.

PS: Désolé d'être passé sur un autre point problèmatique.
26/05/2011, 15h42
mercatog

Quel est le séparateur décimal de ton poste?
26/05/2011, 15h46
Devour

Je pense qu'il s'agit de la virgule parce que lorsque j'appuie sur le point du pavé numérique, j'ai une virgule dans Excel, mais un point dans le bloc-note.
26/05/2011, 17h02
mercatog
Étrange comportement des fichiers.
Ouverts manuellement, les données sont bonnes (avec changement du séparateur décimal en virgule)

Ouverts par code,
Code:

1 2 3 4 Sub Ouvrir() Workbooks.Open "C:\Users\user\Desktop\300 à 500\Falex4003.xls" End Sub
Les virgules sont remplacées par des espace (comme si la virgule était le séparateur des milliers convertie en espace) à l'exception de certaines cellules où la virgule est inchangé mais le nombre est sous format texte.

Il y a certes un amalgame d'interprétation.

PS: Ce problème est un sujet à part.

Après plusieurs essaies, tes fichiers ont l'apparence de fichiers csv.

Dans ton fichier Master, prévoit une feuille appelé" Temp comme feuille temporaire où on importe les données des fichiers pour reformatage et réinjection dans ces fichiers pour exploitation.
Après traitement, les fichiers sont sauvegardés sous format normal (avec un préfixe) Bis_FalexNNNN.xls.

Le code est lancé à partir du fichier Master

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
Option Explicit
 
'1. Sub pour suppression des connexions.
 
Sub ConnectDelete()
Dim Cn As Object
 
Application.DisplayAlerts = False
For Each Cn In ThisWorkbook.Connections
    Cn.Delete
Next Cn
Application.DisplayAlerts = True
End Sub
 
'2. Sub qui permet de tracer le graphique dans un classeur Wbk
 
Sub Incremental(Wbk As Workbook)
Dim Sh As Worksheet
Dim Chrt As Chart
Dim Plage As Range, VectX As Range
Dim LastLig As Long
Dim k As Byte
 
Application.ScreenUpdating = False
'---------Au cas où une feuille Graphe existe déjà, on l'as supprime
On Error Resume Next
Application.DisplayAlerts = False
Wbk.Sheets("Graphe").Delete
Application.DisplayAlerts = True
On Error GoTo 0
'-------------------------------------------------------------------
 
Set Sh = Wbk.Worksheets(1)
With Sh
    .UsedRange.ClearContents
    ThisWorkbook.Worksheets("Temp").UsedRange.Copy .Range("A1")
    ConnectDelete
    ThisWorkbook.Worksheets("Temp").UsedRange.Clear
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set Plage = Union(.Range("B1:C" & LastLig), .Range("I1:I" & LastLig))
    Set VectX = .Range("A1:A" & LastLig)
    Set Chrt = Wbk.Charts.Add
    Chrt.Name = "Graphe"
    With Chrt
        .SetSourceData Plage
        .ChartType = xlXYScatterSmoothNoMarkers
        For k = 1 To 3
            .SeriesCollection(k).XValues = VectX
        Next k
        .SeriesCollection(3).AxisGroup = 2
    End With
    .Activate
End With
Set Chrt = Nothing
Set Plage = Nothing
Set VectX = Nothing
Set Sh = Nothing
End Sub
 
'3. Sub de reformatge des données (Feuille Temp)
 
Sub Formalisation(ByVal Fichier As String)
Dim Sh As Worksheet
 
Set Sh = ThisWorkbook.Worksheets("Temp")
With Sh
    .UsedRange.Clear
    With .QueryTables.Add(Connection:="TEXT;" & Fichier, Destination:=Sh.Range("A1"))
        .FieldNames = True
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With
    .UsedRange.Replace ",", "."
    .UsedRange.Replace "~?", "°"
End With
End Sub
 
'4. Sub récursive qui permet de traiter tous les classeurs Excel commençant par Falex
'dans tous les sous dossiers "xxxx à yyyy"
 
'/!\ Nécessite d'activer la référence "Microsoft Scripting RunTime"
 
Sub Traitement(Chemin As String)
Dim Fso As Scripting.FileSystemObject
Dim DossPere As Scripting.Folder
Dim DossFils As Scripting.Folder, DF As Scripting.Folder
Dim Fichier As Scripting.File
Dim Classeur As String
Dim Wbk As Workbook
 
Application.ScreenUpdating = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set DossPere = Fso.GetFolder(Chemin)
If DossPere.SubFolders.Count > 0 Then
    For Each DF In DossPere.SubFolders
        If DF.Name Like "* à *" Then
            For Each Fichier In DF.Files
                If Fichier.Name Like "Falex*.xls*" Then
                    Classeur = DF.Path & "\" & Fichier.Name
                    Formalisation Classeur
                    Set Wbk = Workbooks.Open(Classeur)
                    Incremental Wbk
                    Application.DisplayAlerts = False
                    Classeur = DF.Path & "\Bis_" & Fichier.Name
                    Wbk.SaveAs Classeur, 56
                    Application.DisplayAlerts = True
                    Wbk.Close
                    Set Wbk = Nothing
                End If
            Next Fichier
            'ICI s'il y a des sous dossiers dans les dossiers
            For Each DossFils In DF.SubFolders
                If DossFils.Name Like "* à *" Then Traitement DossFils.Path
            Next DossFils
            'JUSQU'A ICI
        End If
    Next DF
End If
Set Fso = Nothing
Set DossPere = Nothing
End Sub
 
'5. Sub de Lancement
 
Sub TEST()
Dim t As Long
 
t = Timer
Traitement "C:\Users\user\Desktop"                                   ' à adapter par rapport au dossier père de tous les dossiers à traiter
MsgBox "Traitement terminé en " & Timer - t & " secondes"
End Sub

27/05/2011, 10h52
Devour

Bonjour Mercatog, et merci de ton implication sur ce problème.

Ayant tenté la manipulation, le programme bloque ici:

Code:

.SeriesCollection(k).XValues = VectX

Il affiche cette erreur comme étant un paramètre non valide.

PS:N'étant qu'un débutant, je trouve que le code a tendance à devenir assez compliqué. Il y a bien des choses que je comprends, mais si je dois venir ici à chaque fois qu'il y a un problème, ça me gène de toujours tout demander.
27/05/2011, 11h22
mercatog

Bonjour

En effet, le code devient compliqué à cause de la nature de tes fichiers! j'avais soulevé cette remarque.
En plus, si tu regarde manuellement tes fichiers (au moins le premier que tu as mis en PJ: Falex4000), le dernière ligne de données n'est pas valable (titre des colonnes en plus)
D'où cette erreur.
27/05/2011, 12h18
Devour

Ah oui, très juste.

Ceci est dû au fait que le test de nos machines a été relancé ce qui a rajouté au fichier les en-têtes.

Mais il est vrai que mon idée principale était de généraliser un code pour un seul fichier en fait (pas vraiment pour tout faire d'un coup), c'est-à-dire une macro qui demande le numéro du test sur lequel on veut faire le graphe, et qu'il trace le graphe sur une autre feuille (et que si il existe déjà une feuille appelée "Graph1", "Graph2", etc... avec un graphe à l'intérieur, qu'il la supprime et qu'il en recrée une avec le nouveau graphe).

Dois-je créer un nouveau post pour cette requête ?

Merci

Voir 40 message(s) de cette discussion en une page