[VBS] Données d’un fichier texte dans un tableau Excel.

Version imprimable

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

19/10/2017, 15h13
ProgElecT
Citation:

Je ne me suis pas aperçu de ce désagrément, peux-tu m’en dire un peu plus ?

Lors du défilement vertical, la ligne de date disparait, j'ai rajouté
Code:

1 2 3 4 ExcelObject.Rows(1).select ExcelObject.ActiveWindow.FreezePanes = True SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
Comme tu peux le voir juste avant la sauvegarde, çà fonctionne, mais pas encor exactement comme je le voudrai.
A+
19/10/2017, 19h37
ProgElecT

ExcelObject.Rows(2).select 2 et non 1.
Par contre impossible d'y ajouter la colonne des heures ExcelObject.Columns("B").select , c'est soit l'un soit l'autre.

En ouvrant le fichier avec Excel,

sélection de la cellule B2
menu onglet Affichage
sous menu Fenêtre
sous sous menu Figer les volets
première ligne Figer les volets: Garde des lignes et des colonnes visibles lors de déplacement dans la feuille de calcul (par rapport à la sélection actuelle))[/B].

Donc cela doit être faisable par code, mais comment ?

:yaisse:

Code:

1
2
3
4
5
6
7
'source:
'https://www.developpez.net/forums/d458558/logiciels/microsoft-office/excel/macros-vba-excel/freezepanes-activewindow/#post2766535
SheetObject.Windows(1).SplitColumn = 1
SheetObject.Windows(1).SplitRow = 1
SheetObject.Windows(1).FreezePanes = True
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur

A force de chercher, c'est :ccool: j'ai appris plein de chose sur le tableur Excel

Salut,
Génial, ça le fait grave. :ccool:

:bravo: :bravo: :bravo: :bravo:

De mon coté aussi je me documente sur Excel est ai trouvé Quelques petites amélioration Pour l’info bulle.
1- Adapter la taille de l’info bulle au texte
2- Texte en Gras vers "Maigre" si on peu l'appeler comme ça.
Code:

1 2 3 4 5 6 7 8 9 'ecriture de l'infos bulle écart entre 2 évènements Ping With SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)) .AddComment (TblEcart(T) _ & vbNewLine & "écoulée depuis" _ & vbNewLine & "la précédente latence ") .Comment.Shape.TextFrame.Characters.Font.Bold = False .Comment.Shape.TextFrame.AutoSize = True .Comment.Visible = False End With

20/10/2017, 11h57
Invité

1 pièce(s) jointe(s)

Salut,

A ce stade le tableau est devenue bien plus claire à lire que le fichier rapport.txt non ?

Résultat, des idées d’améliorations fuses.
L’idée ajout d’une colonne et d’une ligne en fin de tableau pour afficher :
-1 Sur cette dernière ligne, le nombre de latences détectées sur la journée.
-2 Sur la dernière colonne le nombre de latences détectées sur la période du XX/XX/2017 au XX/XX/2017 sur la même tranche horaire :
Exemple :
Dernière ligne
10 latences détectées le XX/XX/2017
Dernière Colonne
8 latences détectées sur la période du XX/XX/2017 au XX/XX/2017 a 08 :23 :00.

Pièce jointe 321006

Je ne parviens pas à isoler les TblTmpMax d’une colonne ou d’une ligne pour récupérer l’évènement Count.

Salut

La der des ders :aie: , je me suis fait prendre au jeu, mais il faut que j'avance sur un autre programme.

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
Sub CreatExcel(ChemFichExcel)
Dim L, C, D, H, HH, NomColon
Dim ExcelObject, SheetObject
Dim Dico, HTbl1
'MsgBox "Création du tableau Excel",vbinformation,""
 
If FSO.FileExists(ChemFichExcel) Then FSO.DeleteFile ChemFichExcel, True
'https://vb.developpez.com/faq/vbs?page=Applications-Externes#Comment-piloter-Excel-pour-creer-un-classeur-xls
'https://vb.developpez.com/faq/?page=excel#creerclasseur
'http://drq.developpez.com/vb/tutoriels/Excel/
Set ExcelObject = CreateObject("Excel.Application")
'ExcelObject.Visible = True ' pour debug, à mettre en commentaire quand tous est OK
Set SheetObject = ExcelObject.Workbooks.Add 'Récupération du classeur par défaut
 
'********************************** Construction de la ligne des jours ***********************************************
'Array nom de colonne de 32 indices, la colonne "A" n'est pas utilisé, le premier jour du mois commence en colonne "B" et finit en colonne "AF" pour un mois de 31 jours 
NomColon = Array("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","AA","AB","AC","AD","AE","AF","AG")
'pour date de l'évènement ping, nom d colonne du tableau = NomColon(Day(TblDate(T)))
L = 1 ' l'écriture des dates évènements Ping s'écrit sur la première ligne du tableau
D = Day(TblDate(0)) - 2 'décalage des jours pour un rapport.txt qui ne commence pas par le premier jour du mois
C = Day(TblDate(0)) - D ' calage de l'indice colonne pour le premier jour disponible du fichier rapport.txt
'écriture de la première date disponible en colonne "B"
SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = " " & CStr(TblDate(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
For T = 1 To UBound(TblDate) - 1
    If TblDate(T - 1) <> TblDate(T) Then
        'ne retient que les jours différents
		C = Day(TblDate(T)) - D 'Calcul de la position ou ecrire la date
        SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = " " & CStr(TblDate(T))
    End If
Next
'******************************** construction de la colonne des heures évènements ***********************************
'il faut trier les horaires du plus petit au plus grand
 
'1................ récupération de tous les horaires sans doublon
'création de la variable objet de type Dictionary
Set Dico = CreateObject("Scripting.Dictionary")
Dico.Add TblHeure(0), "0"'Initialise le premier indice avec la première date évènement Ping
For T = 1 To UBound(TblHeure) - 1
    'si dans le tableau Dico la date n'existe pas, incrémente le tableau Dico, si non passe jusqu'à trouver le prochain jour  
	If Not Dico.Exists(TblHeure(T)) Then Dico.Add TblHeure(T), CStr(T)
Next
'Dico contient maintenant chaque jours différents des évènement Ping
HTbl1 = Dico.Keys' récupération du tableau Dico dans le tableau HTbl1
Set Dico = Nothing 'nettoyage
 
'2................ trier les horaires du plus petit au plus grand
trier_tableau HTbl1 'source: http://tahe.developpez.com/web/vbscript/?page=page_5#
'Les horaires sont maintenant trier du premier au dernier dans l'ordre du plus petit au plus grands
'écriture des horaires évènement Ping dans la colonne "A" à partir de la ligne 2 
 
 
'++++++++++++++++++++++++++++++++++++++ New ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim NbrDate, NbrHoraire
NbrDate =  DateDiff ("d",TblDate(0),TblDate(UBound(TblDate)-1)) + 1
NbrHoraire = UBound(HTbl1)
'msgbox "NbrDate = " & NbrDate & vbnewline & "NbrHoraire = " & NbrHoraire
'++++++++++++++++++++++++++++++++++ Fin New ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
For T = 0 To NbrHoraire - 1
        SheetObject.Sheets(1).Range("A" & CStr(T + 3)) = CStr(HTbl1(T)) & " "
Next
 
'****************************** placement des temps maxi *************************************************************
For T = 0 To UBound(TblHeure) - 1
	H = CDate(TblHeure(T))
	For U = 0 To UBound(HTbl1) - 1
		'recherche de la ligne horaire dans le tableau Excel
		HH = SheetObject.Sheets(1).Range("A" & CStr(U + 3)).Text
		If CDate(HH) = H Then
			'la ligne est trouvée
			C = Day(TblDate(T)) - D ' recalcul la colonne ou a été écrit la date correspondante à cette horaire
			'ecriture du temps Max
			SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3)) = TblTmpMax(T)
			'ecriture de l'infos bulle écart entre 2 évènements Ping
			With SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3))
				.AddComment (TblEcart(T) _ 
							& vbNewLine & "écoulée depuis" _
							& vbNewLine & "la précédente latence ")
				.Comment.Shape.TextFrame.Characters.Font.Bold = False
				.Comment.Shape.TextFrame.AutoSize = True			
				.Comment.Visible = False
			End With
		End If
	Next
Next
 '++++++++++++++++++++++++++++++++++++++ New ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'comptage et ecriture du nombre de latence pour cette horaire
For L = 3 To (3 + NbrHoraire)
    U = 0
    For C = 2 To (2 + NbrDate)
        T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        If T <> "" Then U = U + 1
    Next
    If U > 1 Then SheetObject.Sheets(1).Range("B" & CStr(L)) = CStr(U)
Next
'comptage et ecriture du nombre de latence pour ce jour
For C = 2 To (2 + NbrDate)
    U = 0
    For L = 3 To (3 + NbrHoraire)
        T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        If T <> "" Then U = U + 1
    Next
    If U > 1 Then
		SheetObject.Sheets(1).Range(NomColon(C) & "2") = CStr(U)
		SheetObject.Sheets(1).Range(NomColon(C) & "2").HorizontalAlignment = -4108 ' centrage du texte
	End if
Next
SheetObject.Sheets(1).Range("A1").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("B1") = "Date"
SheetObject.Sheets(1).Range("B1").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("A2") = "Horaire"
SheetObject.Sheets(1).Range("A2").HorizontalAlignment = -4108
SheetObject.Sheets(1).Range("A2").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("B2") = "Latence"
SheetObject.Sheets(1).Range("B2").HorizontalAlignment = -4108
 
SheetObject.Sheets(1).Range("B1").Interior.Color = RGB(229, 248, 255)
'couleur de fond lignes horaires
For L = 3 To (2 + NbrHoraire)
	SheetObject.Sheets(1).Range("B" & CStr(L)).Interior.Color = RGB(183, 255, 198)
Next
'couleur de fond colonnes dates
For C = 2 To ( + NbrDate)
	SheetObject.Sheets(1).Range(NomColon(C) & "2").Interior.Color = RGB(183, 255, 198)
Next
'++++++++++++++++++++++++++++++++++ Fin New ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
 'source:
'https://www.developpez.net/forums/d458558/logiciels/microsoft-office/excel/macros-vba-excel/freezepanes-activewindow/#post2766535
SheetObject.Windows(1).SplitColumn = 2
SheetObject.Windows(1).SplitRow = 2
SheetObject.Windows(1).FreezePanes = True
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing
ExcelObject.Application.Quit
Set ExcelObject = Nothing
End Sub

20/10/2017, 21h39
Invité
Citation:

Envoyé par ProgElecT

Salut

La der des ders :aie: , je me suis fait prendre au jeu, mais il faut que j'avance sur un autre programme.

:pc: :merci: :chin:

Salut,
Sympa l’idée de placer les latences juste après Date \ Horaire pour les figer en visu.
J’ai peut être oublié une adaptation, mais ma dernière ligne de latence horaire n’est pas en couleur :whistle2:

Je penses avoir trouvé:

Remplacer:
Code:

1 2 'couleur de fond colonnes dates For C = 2 To ( + NbrDate)
Par:
Code:

1 2 'couleur de fond colonnes dates For C = 2 To (1 + NbrDate)
A confirmer :cfou:
20/10/2017, 23h01
ProgElecT
Code:

1 2 'couleur de fond colonnes dates For C = 2 To ( + NbrDate)
C'était voulu, pour voir si tu suivais :aie:
Blague à par, content que tu puisses corriger ce type d'erreur, donc tu n'as plus besoin de moi pour ce genre de chose.

Au plaisir de te retrouver dans une autre discussion......
20/10/2017, 23h10
Invité

Un grand merci a toi. :king:
Tout le plaisir est pour moi. :ave:
@ bientôt pour de nouvelles aventures. :ccool:

:resolu:
23/10/2017, 16h04
Invité

Bonjour,
Je viens de rencontrer un cas de figure auquel je n'avais pas pensé.
Un des postes exécutant ma tâche planifiée a été arrêté vendredi soir, pour le weekend.
Au redémarrage ma tâche est bien repartie, mais mon fichier de rapport passe du 20/10/2017 au 23/10/2017 vu que le log n'a pas été incrémenté ce qui est normal.
A la génération du fichier Excel, 2 colonnes vide sont créés là au devrait être les colonnes des jours 21 et 22 et perturbe l'écriture des temps Max et le comptage des latences.

La non concordance entre le fichier rapport.txt et le fichier Excel ne vient pas du ou des jours absent dans la liste.
J’ai peut être omis quelque chose :
Avec les fichiers ci-dessous, 4 événements Ping dans le fichier texte contre 3 dans le fichier Excel.

Le script:

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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
'avec regexp depuis le fichier rapport.txt
'(\d*/\d*/\d*) pour retrouver les dates --> 06/10/2017
'\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*) pour retrouver les heures --> 12:14:59
'- (\d*:\d*:\d*) pour trouver les écarts --> 00:19:00
'Maximum = (\d*) pour trouver le temps maximum --> 592
 
' *-*-*- déclaration des variables utilisable dans tout le programme *-*-*-
Const ForReading = 1
Dim T, U
Dim DossProg, MonFichierTxt, MonFichierXlsx
Dim FSO, LectureFichierTxt
Dim StrFichier, TblDate, TblHeure, TblTmpMax , TblEcart 'n'est pas utilisé 
 
 
 
' *-*-*- début du programme *-*-*-
DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"")
MonFichierTxt = DossProg & "rapport.txt"
MonFichierXlsx = DossProg & "Rapport_Visu.xlsx"
 
Set FSO = CreateObject("Scripting.FileSystemObject")
Set LectureFichierTxt = FSO.OpenTextFile(MonFichierTxt, ForReading)
StrFichier = LectureFichierTxt.ReadAll
LectureFichierTxt.Close
Set LectureFichierTxt = Nothing
 
'********************** création du tableau date de l’évènement Ping ***********************************
TblDate = recupTbl("(\d*/\d*/\d*)", StrFichier)
'********************** création du tableau heure de l'évènement Ping **********************************
TblHeure = recupTbl("\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*)", StrFichier)
'arrondir l'heure à la minute entiére en ajoutant Sc+ 30sc, si Mn est plus grand donc incrémente de 1 Mn 
For T = 0 To UBound(TblHeure) - 1
	If Minute(TblHeure(T)) <> Minute(DateAdd("S", 30, TblHeure(T))) Then
        TblHeure(T) = DateAdd("n", 1, TblHeure(T))
    End If
	TblHeure(T) = CDate(Left(TblHeure(T), 6) & "00") 'passe toutes les Sc à zéro
Next
'********************** création du tableau écart entre 2 évènements Ping *******************************
'                                       NON utilisé
TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier)
'********************** création du tableau Temps maximum réponse d'un Ping ****************************
TblTmpMax = recupTbl("Maximum = (\d*)", StrFichier)
 
CreatExcel MonFichierXlsx
Set FSO = Nothing
MsgBox "FAIT"
' -*-*-* programme fini *-*-*-
 
'---------------------------------------------------- Les functions et Subs ----------------------------------------------
Function recupTbl(ExpPattern, DansStr)
'Source: https://www.developpez.net/forums/d1609702/autres-langages/general-visual-basic-6-vbscript/vbscript/vos-contributions-vbscript/manipulation-l-objet-regexp/
Dim RegularExpressioN, ResulT, Match, MsG
 
Set RegularExpressioN = New RegExp
RegularExpressioN.Pattern = ExpPattern
RegularExpressioN.IgnoreCase = True
RegularExpressioN.Global = True
Set ResulT = RegularExpressioN.Execute(DansStr)
For U = 0 To ResulT.Count - 1
    Set Match = ResulT(U)
    If Match.SubMatches.Count > 0 Then
        For T = 0 To Match.SubMatches.Count - 1
            If Trim(Match.SubMatches(T)) <> "" Then
                MsG = MsG & Match.SubMatches(T) & vbNewLine
            End If
        Next
    End If
    Set Match = Nothing
Next
Set ResulT = Nothing
Set RegularExpressioN = Nothing
recupTbl = Split(MsG, vbNewLine)
End Function
'----------------------------------------------------------------------------------------------------------------------
Sub CreatExcel(ChemFichExcel)
Dim L, C, D, H, HH, NomColon
Dim ExcelObject, SheetObject
Dim Dico, HTbl1
'MsgBox "Création du tableau Excel",vbinformation,""
 
If FSO.FileExists(ChemFichExcel) Then FSO.DeleteFile ChemFichExcel, True
'https://vb.developpez.com/faq/vbs?page=Applications-Externes#Comment-piloter-Excel-pour-creer-un-classeur-xls
'https://vb.developpez.com/faq/?page=excel#creerclasseur
'http://drq.developpez.com/vb/tutoriels/Excel/
Set ExcelObject = CreateObject("Excel.Application")
'ExcelObject.Visible = True ' pour debug, à mettre en commentaire quand tous est OK
Set SheetObject = ExcelObject.Workbooks.Add 'Récupération du classeur par défaut
 
'********************************** Construction de la ligne des jours ***********************************************
'Array nom de colonne de 32 indices, la colonne "A" n'est pas utilisé, le premier jour du mois commence en colonne "B" et finit en colonne "AF" pour un mois de 31 jours 
NomColon = Array("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z","AA","AB","AC","AD","AE","AF")
'pour date de l'évènement ping, nom d colonne du tableau = NomColon(Day(TblDate(T)))
L = 1 ' l'écriture des dates évènements Ping s'écrit sur la première ligne du tableau
D = Day(TblDate(0)) - 2 'décalage des jours pour un rapport.txt qui ne commence pas par le premier jour du mois
C = Day(TblDate(0)) - D ' calage de l'indice colonne pour le premier jour disponible du fichier rapport.txt
'écriture de la première date disponible en colonne "B"
SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = " " & CStr(TblDate(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
For T = 1 To UBound(TblDate) - 1
    If TblDate(T - 1) <> TblDate(T) Then
        'ne retient que les jours différents
		C = Day(TblDate(T)) - D 'Calcul de la position ou ecrire la date
        SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = " " & CStr(TblDate(T))
    End If
Next
'******************************** construction de la colonne des heures évènements ***********************************
'il faut trier les horaires du plus petit au plus grand
 
'1................ récupération de tous les horaires sans doublon
'création de la variable objet de type Dictionary
Set Dico = CreateObject("Scripting.Dictionary")
Dico.Add TblHeure(0), "0"'Initialise le premier indice avec la première date évènement Ping
For T = 1 To UBound(TblHeure) - 1
    'si dans le tableau Dico l'heure n'existe pas, incrémente le tableau Dico, si non passe jusqu'à trouver la prochaine heures  
	If Not Dico.Exists(TblHeure(T)) Then Dico.Add TblHeure(T), CStr(T)
Next
'Dico contient maintenant chaque jours différents des évènement Ping
HTbl1 = Dico.Keys' récupération du tableau Dico dans le tableau HTbl1
Set Dico = Nothing 'nettoyage
 
'2................ trier les horaires du plus petit au plus grand
trier_tableau HTbl1 'source: http://tahe.developpez.com/web/vbscript/?page=page_5#
'Les horaires sont maintenant trier du premier au dernier dans l'ordre du plus petit au plus grands
'écriture des horaires évènement Ping dans la colonne "A" à partir de la ligne 2
 
Dim NbrDate, NbrHoraire
NbrDate =  DateDiff ("d",TblDate(0),TblDate(UBound(TblDate)-1)) + 1
NbrHoraire = UBound(HTbl1)
'msgbox "NbrDate = " & NbrDate & vbnewline & "NbrHoraire = " & NbrHoraire
 
For T = 0 To UBound(HTbl1) - 1
        SheetObject.Sheets(1).Range("A" & CStr(T + 3)) = CStr(HTbl1(T)) & " "
Next
 
'****************************** placement des temps maxi *************************************************************
For T = 0 To UBound(TblHeure) - 1
    H = CDate(TblHeure(T))
    For U = 0 To UBound(HTbl1) - 1
        'recherche de la ligne horaire dans le tableau Excel 
		HH = SheetObject.Sheets(1).Range("A" & CStr(U + 3)).Text
		If CDate(HH) = H Then
            'la ligne est trouvée
			C = Day(TblDate(T)) - D ' recalcul la colonne ou a été écrit la date correspondante à cette horaire
            'ecriture du temps Max
			SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3)) = TblTmpMax(T)
			'ecriture de l'infos bulle écart entre 2 évènements Ping
			With SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3))
				.AddComment (TblEcart(T) _ 
							& vbNewLine & "écoulée depuis" _
							& vbNewLine & "la précédente latence ")
				.Comment.Shape.TextFrame.Characters.Font.Bold = False
				.Comment.Shape.TextFrame.AutoSize = True			
				.Comment.Visible = False
			End With	
        End If              
    Next
Next
 
'comptage et ecriture du nombre de latence pour cette horaire
For L = 3 To (3 + NbrHoraire)
    U = 0
    For C = 2 To (2 + NbrDate)
        T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        	If T <> "" Then U = U + 1
    Next
    If U > 1 Then 
    	SheetObject.Sheets(1).Range("B" & CStr(L)) = CStr(U)
'MsgBox(U)
	End If
Next
'comptage et ecriture du nombre de latence pour ce jour
For C = 2 To (2 + NbrDate)
    U = 0
    For L = 3 To (3 + NbrHoraire)
    	T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        	If T <> "" Then U = U + 1
    Next
    	If U > 1 Then
			With SheetObject.Sheets(1)
				.Range(NomColon(C) & "2") = CStr(U)
				.Range(NomColon(C) & "2").HorizontalAlignment = -4108 ' centrage du texte
			End With
		End If
Next
SheetObject.Sheets(1).Range("A1").Interior.Color = RGB(210, 216, 230)
 
With SheetObject.Sheets(1).Range("B1")
	.Value = "Date"
	.HorizontalAlignment = -4108
	.Interior.Color = RGB(210, 216, 230)
End With
 
With SheetObject.Sheets(1).Range("A2")
	.Value = "Horaire"
	.HorizontalAlignment = -4108
	.Interior.Color = RGB(210, 216, 230)
End With
 
With SheetObject.Sheets(1).Range("B2")
	.Value = "Latence"
	.HorizontalAlignment = -4108
End With
 
'couleur de fond lignes horaires
For L = 3 To (2 + NbrHoraire)
	SheetObject.Sheets(1).Range("B" & CStr(L)).Interior.Color = RGB(183, 255, 198)
Next
'couleur de fond colonnes dates
For C = 2 To (1 + NbrDate)
	SheetObject.Sheets(1).Range(NomColon(C) & "2").Interior.Color = RGB(183, 255, 198)
Next
 
'source:
'https://www.developpez.net/forums/d458558/logiciels/microsoft-office/excel/macros-vba-excel/freezepanes-activewindow/#post2766535
SheetObject.Windows(1).SplitColumn = 2
SheetObject.Windows(1).SplitRow = 2
SheetObject.Windows(1).FreezePanes = True
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing
ExcelObject.Application.Quit
Set ExcelObject = Nothing
End Sub
 
'-------------------------------------------- trier_tableau -------------------------------------------------------------
Sub trier_tableau(ByRef T)
' tri le tableau T en ordre croissant
' on cherche l'indice imax du tableau T[0..ifin]
' pour échanger T[imax] avec le dernier élément du tableau T[0..ifin]
' ensuite on recommence avec un tableau ayant 1 élément de moins
Dim ifin, imax, temp
For ifin = UBound(T) To 1 Step -1
' on cherche l'indice imax du tableau T[0..ifin]
imax = chercher_max(T, ifin)
' on l'échange le max avec le dernier élément du tableau T[0..ifin]
temp = T(ifin): T(ifin) = T(imax): T(imax) = temp
Next
End Sub
'-------------------------------------------- chercher_max -------------------------------------------------------------
Function chercher_max(ByRef T, ByVal ifin)
' on cherche l'indice imax du tableau T[0..ifin]
Dim i, imax
imax = 0
For i = 1 To ifin
	If CDate(T(i)) > CDate(T(imax)) Then imax = i
Next
' On rend le résultat
chercher_max = imax
End Function

Le fichier texte:

Citation:

----------- 00:00:00 -----------
06/10/2017 12:14:59
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 20, re‡us = 20, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 592ms, Moyenne = 29ms
----------- 00:19:00 -----------
06/10/2017 12:33:59
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 133ms, Moyenne = 13ms
----------- 00:16:00 -----------
06/10/2017 12:49:59
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 145ms, Moyenne = 14ms
----------- 00:11:00 -----------
06/10/2017 13:00:59
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 106ms, Moyenne = 11ms

Salut

Tu as Trouvé la solution ?

La stratégie ayant changé, il faut modifier une bonne partie de la sub CreatExcel, voilà la mienne.

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
Sub CreatExcel(ChemFichExcel)
Dim L, C, H, HH, NomColon
Dim ExcelObject, SheetObject
Dim Dico, HTbl1
Dim NbrDateDiff, NbrHoraire
'MsgBox "Création du tableau Excel",vbinformation,""
 
If FSO.FileExists(ChemFichExcel) Then FSO.DeleteFile ChemFichExcel, True
'https://vb.developpez.com/faq/vbs?page=Applications-Externes#Comment-piloter-Excel-pour-creer-un-classeur-xls
'https://vb.developpez.com/faq/?page=excel#creerclasseur
'http://drq.developpez.com/vb/tutoriels/Excel/
Set ExcelObject = CreateObject("Excel.Application")
'ExcelObject.Visible = True ' pour debug, à mettre en commentaire quand tous est OK
Set SheetObject = ExcelObject.Workbooks.Add 'Récupération du classeur par défaut
 
'********************************** Construction de la ligne des jours ***********************************************
'Array nom de colonne de 32 indices, la colonne "A" n'est pas utilisé, le premier jour du mois commence en colonne "B" et finit en colonne "AF" pour un mois de 31 jours
NomColon = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG")
'pour date de l'évènement ping, nom d colonne du tableau = NomColon(Day(TblDate(T)))
L = 1 ' l'écriture des dates évènements Ping s'écrit sur la première ligne du tableau
'écriture de la première date disponible en colonne "B"
SheetObject.Sheets(1).Range(NomColon(2) & CStr(L)) = " " & CStr(TblDate(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
C = 3: NbrDateDiff = 0
For T = 1 To UBound(TblDate) - 1
    If TblDate(T - 1) <> TblDate(T) Then
        'ne retient que les jours différents
        SheetObject.Sheets(1).Range(NomColon(C) & "1") = " " & CStr(TblDate(T))
        C = C + 1
        NbrDateDiff = NbrDateDiff + 1
    End If
Next
'******************************** construction de la colonne des heures évènements ***********************************
'il faut trier les horaires du plus petit au plus grand
 
'1................ récupération de tous les horaires sans doublon
'création de la variable objet de type Dictionary
Set Dico = CreateObject("Scripting.Dictionary")
Dico.Add TblHeure(0), "0" 'Initialise le premier indice avec la première date évènement Ping
For T = 1 To UBound(TblHeure) - 1
    'si dans le tableau Dico la date n'existe pas, incrémente le tableau Dico, si non passe jusqu'à trouver le prochain jour
    If Not Dico.Exists(TblHeure(T)) Then Dico.Add TblHeure(T), CStr(T)
Next
'Dico contient maintenant chaque jours différents des évènement Ping
HTbl1 = Dico.Keys ' récupération du tableau Dico dans le tableau HTbl1
Set Dico = Nothing 'nettoyage
 
'2................ trier les horaires du plus petit au plus grand
trier_tableau HTbl1 'source: http://tahe.developpez.com/web/vbscript/?page=page_5#
'Les horaires sont maintenant trier du premier au dernier dans l'ordre du plus petit au plus grands
'écriture des horaires évènement Ping dans la colonne "A" à partir de la ligne 2
NbrHoraire = UBound(HTbl1)
For T = 0 To NbrHoraire
        SheetObject.Sheets(1).Range("A" & CStr(T + 3)) = CStr(HTbl1(T)) & " "
Next
 
'****************************** placement des temps maxi *************************************************************
For T = 0 To UBound(TblHeure) - 1
    H = CDate(TblHeure(T))
    For U = 0 To NbrHoraire
        'recherche de la ligne horaire dans le tableau Excel
        HH = SheetObject.Sheets(1).Range("A" & CStr(U + 3)).Text
        If CDate(HH) = H Then 'la ligne est trouvée
            For C = 2 To NbrDateDiff + 2 'recherche de la date correspondante à cette horaire
                If Trim(SheetObject.Sheets(1).Range(NomColon(C) & "1")) = CStr(TblDate(T)) Then Exit For
            Next
            'ecriture du temps Max
            SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3)) = TblTmpMax(T)
            'ecriture de l'infos bulle écart entre 2 évènements Ping
            With SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 3))
                .AddComment (TblEcart(T) _
                            & vbNewLine & "écoulée depuis" _
                            & vbNewLine & "la précédente latence ")
                .Comment.Shape.TextFrame.Characters.Font.Bold = False
                .Comment.Shape.TextFrame.AutoSize = True
                .Comment.Visible = False
            End With
        End If
    Next
Next
'comptage et ecriture du nombre de latence pour cette horaire
For L = 3 To (3 + NbrHoraire)
    U = 0
    For C = 2 To (2 + NbrDateDiff)
        T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        If T <> "" Then U = U + 1
    Next
    If U > 1 Then SheetObject.Sheets(1).Range("B" & CStr(L)) = CStr(U)
Next
'comptage et ecriture du nombre de latence pour ce jour
For C = 2 To (2 + NbrDateDiff)
    U = 0
    For L = 3 To (3 + NbrHoraire)
        T = CStr(Trim(SheetObject.Sheets(1).Range(NomColon(C) & CStr(L))))
        If T <> "" Then U = U + 1
    Next
    If U > 1 Then
        SheetObject.Sheets(1).Range(NomColon(C) & "2") = CStr(U)
        SheetObject.Sheets(1).Range(NomColon(C) & "2").HorizontalAlignment = -4108 ' centrage du texte
    End If
Next
SheetObject.Sheets(1).Range("A1").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("B1") = "Date"
SheetObject.Sheets(1).Range("B1").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("A2") = "Horaire"
SheetObject.Sheets(1).Range("A2").HorizontalAlignment = -4108
SheetObject.Sheets(1).Range("A2").Interior.Color = RGB(229, 248, 255)
 
SheetObject.Sheets(1).Range("B2") = "Latence"
SheetObject.Sheets(1).Range("B2").HorizontalAlignment = -4108
 
SheetObject.Sheets(1).Range("B1").Interior.Color = RGB(229, 248, 255)
'couleur de fond lignes horaires
For L = 3 To (3 + NbrHoraire) '(2 + NbrHoraire)
    SheetObject.Sheets(1).Range("B" & CStr(L)).Interior.Color = RGB(183, 255, 198)
Next
'couleur de fond colonnes dates
For C = 2 To (2 + NbrDateDiff)
    SheetObject.Sheets(1).Range(NomColon(C) & "2").Interior.Color = RGB(183, 255, 198)
Next
 'source:
'https://www.developpez.net/forums/d458558/logiciels/microsoft-office/excel/macros-vba-excel/freezepanes-activewindow/#post2766535
SheetObject.Windows(1).SplitColumn = 2
SheetObject.Windows(1).SplitRow = 2
SheetObject.Windows(1).FreezePanes = True
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing
ExcelObject.Application.Quit
Set ExcelObject = Nothing
End Sub

Par mesure de sécurité, sauvegarde ta version avant que d'utiliser cette nouvelle version.

24/10/2017, 21h13
Invité

Salut,
Ça semble Bon, Le nombre d’occurrences du fichier Excel est identique au fichier Texte, ainsi que le nombre de Dates.

Petite question pour être sur de l’interprétation que je fais du code :

En ligne 20 tu défini la valeur de "L".

Code:

L = 1

Que tu exploite en ligne 22

Code:

SheetObject.Sheets(1).Range(NomColon(2) & CStr(L)) = " " & CStr(TblDate(0))

Mais pas en ligne 27.

Code:

SheetObject.Sheets(1).Range(NomColon(C) & "1") = " " & CStr(TblDate(T))

Y a t’il une raison particulière ou je n’ai pas bien compris ?

J’essaie de comprendre comment NbrDate et DateDiff sont devenue NbrDateDiff.
24/10/2017, 23h04
ProgElecT

Salut

Pour le L ligne 20, en effet, mauvais nettoyage, on pourrait plutôt écrire la ligne 22

Code:

SheetObject.Sheets(1).Range(NomColon(2) & "1") = " " & CStr(TblDate(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date

et supprimer cette ligne 20.

Par contre, lignes 'comptage et écriture du nombre de latence pour cette horaire et 'comptage et ecriture du nombre de latence pour ce jour , là c'est utile car l'indice ligne est dans les 2 boucles For......Next et que les lignes sont incrémentés.

Pour la ligne 27, au lieux de convertir le L numérique en littéral, autant le mettre directement puisqu'il ne varie pas dans la boucle.

Citation:

J’essaie de comprendre comment NbrDate et DateDiff sont devenue NbrDateDiff.

Étant donné que les colonnes ne suive pas forcément les jours du mois, on ne peut plus calculer le nombre de jours à afficher en soustrayant la date de fin moins la date de début.
Exemple 1:
- du 5 au 25 = 25-5 donc 20 si ce sont des jours consécutifs, NbrDate = DateDiff ("d",TblDate(0),TblDate(UBound(TblDate)-1)) + 1 est ok pour cette exemple.
Exemple 2:
- du 5 au 25, mais pas de Ping le 7 et le 8, donc (25-5) - 2 = 18, la formule de l'exemple 5 ne répond plus au nouveau besoin de pouvoir escamoter x jours.
26/10/2017, 08h16
Invité

Salut,
Merci pour ce complément d'informations. :ccool:
Je reviendrais vers toi si besoin, mais apparemment tout est OK.

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