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
| Sub Transfer_Enregistrements_vers_Excel()
Dim TheTemporaryArray 'défini un tableau unidmensionel pour la capture des lignes du fichier texte
Dim TheFinalArray() As Variant 'défini un tableau bidmensionel pour l'enregistrement informatique du fichier texte
Dim FileName As Variant 'defini une variable qui contiendra le nom du fichier texte a ouvrir
Dim strRec As String 'defini une variable qui contiendra une ligne du fichier texte
Dim j As Long 'defini une variable qui sera utilisée dans un "compteur" de données
Dim i As Long 'defini une variable qui sera utilisée dans un "compteur" de données
Dim m As Long 'defini une variable qui sera utilisée dans un "compteur" de données
Dim k As Long 'defini une variable qui sera utilisée dans un "compteur" de données
Dim xx As Long 'Defini une variable qui contiendra la limite haute du tableau bidimensionel
Dim DerLig As Long
Dim Plage As Range
'*******************************************************
Dim n As Long
Dim TabTemps As Variant, TabVmoy As Variant
'*******************************************************
FileName = Application.GetOpenFilename("Text Files (*.txt),*.txt", , "Select Text Data File") 'Ouvre une fentre de selection de fichier qui permet a l'utilisateur de selectionner le fichier a importer. exclusivement des fichiers texte
If FileName = False Then 'Si l'utilisateur n'a pas sélectionner de fichier
Exit Sub 'alors fin de la procedure
ElseIf FileName <> False Then 'Si l'utilisateur à sélectionner un fichier
Open FileName For Input As #1 'Ouvre le fichier texte
Line Input #1, strRec 'Lit une ligne du fichier et enregistre la ligne
TheTemporaryArray = Split(strRec, Chr(9)) 'Enregistre chaque element de la ligne séparé par un "tab" dans un tableau unidimensionel appellé TheTemporaryArray
ReDim TheFinalArray(UBound(TheTemporaryArray), LBound(TheTemporaryArray)) 'Précise la dimension du tableau.
xx = UBound(TheFinalArray) 'enregistre dans une variable la limite haute du tableau - normalement le nombre de "colonnes" du fichier texte moins 1 car le tableau commence a zero et non pas 1
Close #1 'ferme le fichier texte. Cela est necessaire pour une future redimension du tableau TheFinalArray
i = 1 'donne la valeur 1 a une variable qui servira dans la definition d'un tableau bidimensionel
Open FileName For Input As #1 'Réouvre le fichier texte
'****** l'étape suivante va etre repetée pour chaque ligne du fichier grace à la commande "Do While...Loop" *****
Do While Not EOF(1) 'Faire quelque chose jusqu'à temps que l'on arrive à la fin du fichier texte
Line Input #1, strRec 'Lit une ligne du fichier et enregistre la ligne
TheTemporaryArray = Split(strRec, vbTab) 'Enregistre chaque element de la ligne séparé par un "tab" dans un tableau unidimensionel appellé TheTemporaryArray
For j = LBound(TheTemporaryArray) To UBound(TheTemporaryArray) 'Pour chaque élément du tableau unidimensionel
TheFinalArray(j, i - 1) = TheTemporaryArray(j) 'l'élément du tableau unidimensionel est entré dans un tableau bidimensionel
Next j 'tourne jusqu'à temps qu'il n'y ai plus d'elements dans le tableau unidimensionel
ReDim Preserve TheFinalArray(xx, i) 'Redimensionne le tableau bidimensionel en y ajoutant une "ligne"
i = i + 1 'augmemte la variable comptable qui aide a la redimension du tableau bidimensionel
Loop 'repete les etapes precedente pour chaque "ligne" du ficher texte
Close #1 'Ferme le fichier texte
'**** L'etape suivante transfer les données dans EXCEL ****
'Jusqu'ici toutes les données ont été transferées dans un tableau multidimensionel et non pas diretement dans Excel
Sheets("Import de données radar").Activate 'sélectionne l'onglet où les données seront transcrites
Cells.Select 'selectionne toutes les cellule de l'onglet
Selection.ClearContents 'efface le contenu des cellules seletionnées
Cells(1, 1).Select 'retire la selection de toutes les cellules
For k = 0 To xx 'Pour chaque "colonne" du tableau bidimensionel faire....
For m = 0 To (i - 1) 'Pour chaque "ligne" du tableau bidimentionel faire...
Cells(m + 1, k + 1) = TheFinalArray(k, m) 'un transfer de l'element du tableau bidimensionel vers Excel
Next m 'repeter pour chaque "ligne" du tableau bidimensionel
Next k 'repeter pour chaque "colonne" du tableau bidimensionel
Sheets("Menu").Activate 'reselectionne l'onglet avec le bouton
End If 'ferme la condition d'execution de la procedure liée à la trouvaille du nom de fichier
'*******************************************************************
' Activer la feuille de données
Sheets("Import de données radar").Activate
DerLig = Cells(Rows.Count, 1).End(xlUp).Row
Set Plage = Range("A2:A" & DerLig)
Set Plage = Union(Plage, Plage.Offset(, 4))
Var = Plage.Address
' Redimensionner les tableaux
'TabTemps = Application.Transpose(Range([A2], Cells(Rows.Count, 1).End(xlUp)))
'Création du tableau pour les Abscisses
'Création d'un tableau pour les Ordonnées
'TabVmoy = Application.Transpose(Range([E2], Cells(Rows.Count, 5).End(xlUp)))
'Création graphique
Charts.Add
With ActiveChart
.ChartType = xlLine
.SetSourceData Source:=Plage, PlotBy:=xlColumns
.Location Where:=xlLocationAsObject, Name:="Test"
End With
'*******************************************************************
End Sub 'fin de la procedure |
Répondre avec citation
Partager