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 160 161 162 163 164 165 166 167
| Option Explicit
Dim i As Integer
Dim fichier_courant As String 'Nom du classeur dans lequel on se trouve
Dim Nom_Fichier As Variant 'Récupère le nom du fichier à importer
Dim nb_file As Integer, ligne As Integer, colonne As Integer
Dim awbk As Workbook, wbk As Workbook
Dim list_Range As Range
Dim Nom_Graphique As String, legende_abscisses As String, legende_ordonnees As String
Dim Nom_Graphique1 As String, Nom_Graphique2 As String, Nom_Graphique3 As String
Public Sub CommandButton1_Click()
'Affectation à la variable awbk (ActiveWorkBook) du nom du classeur courant
Set awbk = ActiveWorkbook
awbk.Protect Structure:=False, Windows:=False
'Sélection de la plage d'inscription du listing de fichier importés
Set list_Range = Worksheets("Listing").Range("a3:a23")
'Nettoyage de la plage d'affichage
list_Range.ClearContents
'Choix de la ligne de départ de l'affichage (mis à 18 pour être conforme à l'emplacement
'des données dans le fichier d'origine, plus facile pour faire des comparaisons, possible
'de copier toute la colonne)
ligne = 18
'Non mise à jour de l'écran en temps réel afin de diminuer le temps de calcul
Application.ScreenUpdating = False
'Nettoyage de la plage d'affichage
awbk.Worksheets("Affichage").Range("a16:ff5000").ClearContents
'Récupération du nombre de fichier à copier
nb_file = awbk.Sheets("Lancement").Range("D6").Value
legende_abscisses = "Temps [s]"
Nom_Graphique1 = "Pression"
Nom_Graphique2 = "Débits"
Nom_Graphique3 = "Température"
'Boucle de récupération des données
If nb_file > 0 Then
'Choix de la ligne où commencer à inscrire les valeurs
ligne = 18
For i = 1 To nb_file
'Boucle conditionnelle qui permet de décaler la première colonne de réinscription à chaque nouveau fichier
If i = 1 Then
colonne = i
Nom_Graphique = "Pression"
legende_ordonnees = "Pression [bar]"
Call New_Graphique(Nom_Graphique1, legende_abscisses, legende_ordonnees)
Nom_Graphique = "Débits"
legende_ordonnees = "Débit [kg/s]"
Call New_Graphique(Nom_Graphique2, legende_abscisses, legende_ordonnees)
Nom_Graphique = "Température"
legende_ordonnees = "Température [°C]"
Call New_Graphique(Nom_Graphique3, legende_abscisses, legende_ordonnees)
Else
colonne = 1 + 4 * i - 4
End If
'Récupération du nom du fichier à rappatrier
Nom_Fichier = Application.GetOpenFilename(, , "Sélectionnez la sensibilité à extraire")
If Nom_Fichier <> False Then
'Affectation du nom du fichier à la variable wbk (WorkBook)
Set wbk = Workbooks.Open(Nom_Fichier)
'Copie des valeurs de temps
wbk.Sheets("Onglet_1").Range("B18:B3000").Copy awbk.Sheets("Affichage").Cells(ligne, colonne)
'Copie des valeurs de pression DC
wbk.Sheets("Onglet_1").Range("C18:C3000").Copy awbk.Sheets("Affichage").Cells(ligne, colonne + 1)
'Copie des valeurs de débit DC
wbk.Sheets("Onglet_1").Range("L18:L3000").Copy awbk.Sheets("Affichage").Cells(ligne, colonne + 2)
'Copie des valeurs de Température CREARE
wbk.Sheets("Onglet_1").Range("P18:P3000").Copy awbk.Sheets("Affichage").Cells(ligne, colonne + 3)
'Inscription de l'entête pour chacune des colonnes
awbk.Sheets("Affichage").Cells(ligne - 1, colonne).Value = "Temps [s]"
awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 1).Value = "Pression [bar]"
awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 2).Value = "Débit [kg/s]"
awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 3).Value = "Température [°C]"
Call New_plot
'Ferme le fichier qui a été ouvert pour y recopier les valeurs
wbk.Close
'Vide la variable wbk
Set wbk = Nothing
End If
'Inscription du nom du fichier utilisé afin de réaliser une traçabilité des données
list_Range.Cells(i) = Nom_Fichier
Next i
End If
awbk.Protect Structure:=True, Windows:=True
'Vide la variable awbk afin de ne pas surcharger la mémoire
Set awbk = Nothing
'Mise à jour de l'affichage
Application.ScreenUpdating = True
End Sub
Public Sub New_Graphique(Nom_Graphique, legende_abscisses, legende_ordonnees)
Charts.Add
ActiveChart.ChartType = xlXYScatterSmoothNoMarkers
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=Nom_Graphique
With ActiveChart
.HasTitle = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = legende_abscisses
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = legende_ordonnees
End With
End Sub
Public Sub New_plot()
Sheets(Nom_Graphique1).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).XValues = awbk.Sheets("Affichage").Cells(ligne - 1, colonne)
ActiveChart.SeriesCollection(i).Values = awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 1)
Sheets(Nom_Graphique2).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).XValues = awbk.Sheets("Affichage").Cells(ligne - 1, colonne)
ActiveChart.SeriesCollection(i).Values = awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 2)
Sheets(Nom_Graphique3).Select
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).XValues = awbk.Sheets("Affichage").Cells(ligne - 1, colonne)
ActiveChart.SeriesCollection(i).Values = awbk.Sheets("Affichage").Cells(ligne - 1, colonne + 3)
End Sub |
Partager