Macro de construction d'un graphe composé

Version imprimable

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

27/05/2011, 12h47
mercatog

Ok, c'est la même logique. le code sera certes simplifié.
Une question. tu veux créer le graphique sur le fichier source (exemple sur Flex4001) ou sur le fichier d'où on lance le code?
27/05/2011, 13h08
Devour

Oui, sur le fichier source.

Voici mon programme Labview qui commandera Excel et lui dira d'ouvrir telle ou telle macro (en l'occurence celle que je veux faire). Elle sera donc présente dans Excel par défaut.

http://www.monsterup.com/upload/1306494408764.jpg

Merci Mercatog
27/05/2011, 13h19
mercatog

LabView je ne connais pas et je n'ai pas les compétences pour te répondre.

Sur le principe: J'ai un Fichier Excel Master où sont écrite les macros. à partir de ce fichier Master, il ouvre les fichiers X (Maintenant tu veux spécifier un seul fichier), importe les données dans une feuille Temp du Fichier MASTER. Adapte les données (pour rectifier le problème des virgules qui disparaissent), réinjecte les données rectifiés dans le fichier initial, trace la graphique et enregistre le fichier X sous format excel en Bis_X.

J'espère que tu me suis pour pouvoir concrètement me réponde.

Quel est la question? (ne me parle pas svp de LabView)
27/05/2011, 14h28
Devour

C'est à peu près cela oui.
Il y aurait un fichier master avec le code qui s'applique comme si le fichier master était le classeur comportant les données. (fichier master placé dans les classeurs personnels, non ?)

Cela signifie donc que dans le code, tu n'as logiquement pas besoin de dire que celui s'applique sur tel fichier .xls puisque le code agit comme si il s'agissait du classeur actif.

Mais après c'est vrai que cette histoire de séparateur décimal, ça me perturbe...

As tu testé le code sur 2 fichiers Falx4001 et Falx4002???

Mets les dans un dossier que tu appellera "4001 à 4002" sur le bureau et adapte cette ligne au chemin de ton bureau
Code:

1 2 3 4 5 6 7 Sub TEST() Dim t As Long t = Timer Traitement "C:\Documents and Settings\Administrateur\Bureau" 'ICI à adapter par rapport au dossier père de tous les dossiers à traiter MsgBox "Traitement terminé en " & Timer - t & " secondes" End Sub

Voici le chemin d'un de mes 2 fichiers:

Citation:

C:\Documents and Settings\XXXXX\Bureau\Files_Falex\4001 à 4003\Falex4001.xls

Pour tester le code, j'ai donc créer un nouveau classeur que j'ai renommer "Test.xlsm", j'ai renommé la première feuille comme étant "Temp", puis j'ai fais:
Afficher les macros > Je donne le nom "X" à la macro > Je fais créer dans PERSONAL.XLSB > Je copie ton code en remplaçant

Code:

1
2
3
Sub X()
 
End Sub

Par

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:\Documents and Settings\Administrateur\Bureau"    'ICI à adapter par rapport au dossier père de tous les dossiers à traiter
MsgBox "Traitement terminé en " & Timer - t & " secondes"
End Sub

Et après pour lancer, je refais afficher les macros et je mets Exécuter "PERSONAL.XLSB!ConnectDelete". A ce moment, il ne se passe rien.
Donc je mets Exécuter "PERSONAL.XLSB!TEST". Et là, j'obtiens l'erreur 9:

Citation:

L'indice n'appartient pas à la sélection

Utilisant la commande Débogage, il s'arrête sur cette ligne jaune:

Code:

Set Sh = ThisWorkbook.Worksheets("Temp")

PS: Désolé d'avoir écrit si long mais je mets ma méthode car peut-être ce n'est pas bon comment je mets en place et j'exécute les codes.

27/05/2011, 15h33
mercatog

Non
Crée un fichier normal Excel contenant une feuille nommée Temp
Dans l'éditeur vba de ce fichier, crée un module standard et y colle le code

Pour tester lance la procédure TEST() , la dernière.

EDIT

PS: Avant chaque macro, j'ai mis une petite ligne en commentaire qui explique que fais chaque macro.

PS2: le chemin du dossier père

Citation:

C:\Documents and Settings\XXXXX\Bureau\Files_Falex
27/05/2011, 15h40
Devour

Oui effectivement, ça marche !

J'ai bien compris aussi les lignes vertes descriptives de chaque section.
27/05/2011, 15h45
mercatog

En résultat, as-tu un fichier nommé Bis_Falex4001.xls contenant les données re formatées et le graphique?
27/05/2011, 15h51
Devour

Tout à fait.
Tout fonctionne à merveille.

[EDIT]Est-il possible selon toi de créer un code spécial au fichier Falex4001.xls, pour que le graphe soit tracé dans une seconde feuille, et que le fichier s'enregistre sous le même nom ?

J'ai tenté d'extraire la partie Sub Incrémental de ton code complet en créant une macro directement dans le fichier Falex4001.xls et en y collant cette partie mais j'ai un soucis qui m'indique:

Citation:

Erreur d'exécution '91':
Variable objet ou variable de bloc With non définie

Le code s'arrête ici:

Code:

Set Sh = Wbk.Worksheets(1)

Merci déjà d'avoir réussi une grosse partie de code tout à l'heure.
27/05/2011, 17h33
mercatog

Essaies d'expliquer clairement (si la question est en relation avec la question initiale).

Tu veux copier le code dans tous les fichiers sans être pilotés par un fichier MASTER ou bien tu veux à partir du fichier MASTER donner la possibilité à l'utilisateur de choisir le fichier à traiter.

Un autre souci, la code proposé travaille sur tes fichiers bruts (qui ont la structure d'un csv). enregistrer le fichier brut avec le même nom est possible, mais une fois le fichier enregistré au format excel normal, il n'est plus possible de lui appliquer le code tel une 2ème fois.

Une autre réflexion, c'est d'appliquer 2 procédure. la première re formate les données des fichiers et l'autre y trace les graphiques.

J'aimerais pouvoir donner la possibilité à l'utilisateur le choix du fichier à traiter, c'est ça oui, mais le choix ne se ferait pas dans Excel, je m'occupe de cette partie.

J'aimerais seulement connaitre le code nécessaire à un fichier et qui serait propre à ce fichier. Mais le code sera au final conservé dans un fichier MASTER qui ne sera jamais appelé (juste le code le sera).

L'histoire des deux procédures peut-être bien vue oui.

J'aimerais savoir également si c'est possible de supprimer la mémoire en cours du fichier. Car si on ajoute une feuille, elle s'appelle Feuil2; on la supprime, on veut la recréer, elle s'appelle maintenant Feuil3. Cela signifie que le fichier compte en mémoire le nombre de nouvelle feuille.

Quelle serait la ligne de code à ajouter pour supprimer la mémoire du fichier ?

Merci

[EDIT] Il faut simplement fermer et ouvrir à nouveau pour vider le cache mais je pense qu'il doit exister une autre solution.

Autrement, j'ai réussi une partie de code:

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 Sub Fin() ' ' Fin Macro ' ' ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xlXYScatterSmoothNoMarkers ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).Name = "=""Temp""" ActiveChart.SeriesCollection(1).XValues = "='Falex5023'!$A:$A" ActiveChart.SeriesCollection(1).Values = "='Falex5023'!$B:$B" ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(2).Name = "=""Torque""" ActiveChart.SeriesCollection(2).XValues = "='Falex5023'!$A:$A" ActiveChart.SeriesCollection(2).Values = "='Falex5023'!$I:$I" ActiveChart.SeriesCollection(1).Select ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.SeriesCollection(1).AxisGroup = 2 ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.SeriesCollection(1).Select ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.ChartArea.Select ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Graph" ActiveChart.HasTitle = True ActiveChart.ChartTitle.Characters.Text = "Falex X" ActiveChart.Axes(xlCategory, xlPrimary).HasTitle = True ActiveChart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Time (s)" ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Torque (N.m)" ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Temp (°C)" End Sub

Il me manque donc plus qu'à mettre le titre de l'axe secondaire dans l'autre sens (pivoté de 90° mais vers la droite), à trouver une solution pour indiquer que le titre du graphe est tout simplement le nom de la première feuille et à indiquer que les cellules à sélectionner se trouve dans la feuille actuelle et non pas dans "Falex 5023" comme à la ligne 11 ou 12 du code.

Pour faire pivoter le texte, j'obtiens ce code:

Code:

1 2 3 ActiveSheet.ChartObjects("Graphique 1").Activate ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Select ActiveSheet.ChartObjects("Graphique 1").Activate

Je n'arrive pas à voir où il pivote.

Puis pour le titre et la sélection de cellules, je ne sais pas comment faire.

Merci de votre aide

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