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

Version imprimable

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

13/10/2017, 16h06
Invité

2 pièce(s) jointe(s)

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

Bonjour,
J’aimerais récupérer les informations du fichier texte joint « rapport.txt » et les intégrer dans un tableau Excel afin d’avoir une vue d’ensemble.
L’idée en colonne les horaires sur 24 heures en minutes et en lignes de chaque jour.
Dans ce tableau incrémenter les valeurs :
Maximum = XXXX en MS
Le jour et l’heure
Dans le but d’avoir un visu global afin de Déterminer si ces valeurs sont aléatoires ou récurrentes dans le temps.
Pièce jointe 319173
Pièce jointe 319177

Un 1er essaie, histoire de me familiariser avec l’objet Excel depuis VB.
Donc
Un fichier texte contenant 2 lignes :

Citation:

test N°1 lecture TXT écriture XLSX ligne 1
test n°2 lecture TXT écriture XLSX ligne 2

Et un fichier Excel.

Le but : récupérer « test N°1 » et « ligne 1 » est les placers respectivement dans les cellules A1 et A2
Idem pour la deuxième ligne en B1 et B2.

Ça fonctionne mais j’ai un petit souci.

1- Mes fichiers sont placés dans le même répertoire que le script, je ne parviens pas a les faire prendre en charge sans mettre le chemin en dure (App.Path).

2- Là, la récupération est faite en comptant le nombre de caractères, ce que je ne peux pas faire avec mon fichier « rapport.txt » vu que le nombre de caractères et changeant.

Comment géreriez-vous ? Avec des balises ?
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 Option Explicit Const ForReading = 1 Dim MonFichierTxt, MonFichierXlsx, L1, L2, FSO, LectureFichierTxt, ExcelObject, SheetObject, Ligne1, Ligne2, Cellule1_1, Cellule1_2, Cellule2_1, Cellule2_2 MonFichierTxt = "C:\test\Fichier_Source.txt" Set FSO = CreateObject("Scripting.FileSystemObject") Set LectureFichierTxt = FSO.OpenTextFile(MonFichierTxt, ForReading) L1 = 1 L2 = 2 MonFichierXlsx = "C:\test\Fichier_Cible.xls" Set ExcelObject = CreateObject("Excel.Application") ExcelObject.WorkBooks.Open MonFichierXlsx Set SheetObject = ExcelObject.ActiveWorkbook.Worksheets(1) Do Until LectureFichierTxt.AtEndOfStream Ligne1 = LectureFichierTxt.ReadLine Cellule1_1 = Trim(Mid(Ligne1, 1, 8)) Cellule1_2 = Mid(Ligne1, 36, 42) Ligne2 = LectureFichierTxt.ReadLine Cellule2_1 = Mid(Ligne2, 1, 8) Cellule2_2 = Mid(Ligne2, 36, 42) SheetObject.Cells(L1, 1).Value = Cellule1_1 SheetObject.Cells(L1, 2).Value = Cellule1_2 SheetObject.Cells(L2, 1).Value = Cellule2_1 SheetObject.Cells(L2, 2).Value = Cellule2_2 L1 = L1+ 1 L2 = L2 + 1 Loop ExcelObject.ActiveWorkbook.Save ExcelObject.ActiveWorkbook.Close ExcelObject.Application.Quit

Salut

Citation:

1- Mes fichiers sont placés dans le même répertoire que le script, je ne parviens pas a les faire prendre en charge sans mettre le chemin en dure (App.Path).
Code:

1 2 3 4 5 6 7 Dim DossProg, MonFichierTxt, MonFichierXlsx DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"") MonFichierTxt = DossProg & "Fichier_Source.txt" MonFichierXlsx = DossProg & "Fichier_Cible.xls" MsgBox "MonFichierTxt = " & MonFichierTxt & vbNewLine & vbNewLine & _ "MonFichierXlsx = " & MonFichierXlsx

Décidément je ne suis pas du tout à mon aise avec Excel.
Un petit coup de main SVP ?

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
Option Explicit
 
Dim fso, DossProg, FichierTxt
Dim BaliseDebut, BaliseFin
Dim DebutOu, FinOu
Dim TblChapitre, TblLgn, Recup, T
Dim chaine1, chaine2, chaine3
 
 
Set fso = CreateObject("Scripting.FileSystemObject")
DossProg = replace(WScript.ScriptFullName,WScript.ScriptName,"")
Set FichierTxt = fso.opentextfile(DossProg & "rapport.txt", 1)
TblChapitre = Split(FichierTxt.ReadAll, "--------------------------------", -1, vbTextCompare)
FichierTxt.Close
Set FichierTxt = Nothing
 
BaliseDebut = "Maximum = "
BaliseFin = ", Moyenne"
For T = 0 To UBound(TblChapitre) - 1
    DebutOu = InStr(1, TblChapitre(T), BaliseDebut)
    If DebutOu <> 0 Then ' DebutOu a été trouvé
        DebutOu = DebutOu + Len(BaliseDebut)
        FinOu = DebutOu
        FinOu = InStr(FinOu, TblChapitre(T), BaliseFin)
        Recup = Mid(TblChapitre(T), DebutOu, (FinOu-2) - DebutOu) 'récupération du chiffre (tempo Maximum) pour ce Ping
 
           TblLgn = Split(TblChapitre(T), vbNewLine, -1, vbTextCompare) ' découpe en un tableau de chaque ligne du chapitre d'1 Ping 
 
 	   chaine1 = chaine1 & Recup & vbNewLine' & _
 	   chaine2 = chaine2 & Mid(TblLgn(1), 1, 10) & vbNewLine' & _ 	   							
 	   chaine3 = chaine3 & Trim(Mid(TblLgn(1), 12, Len(TblLgn(1)) - 15)) & vbNewLine 
 
      End If                              
Next
MsgBox chaine1
MsgBox chaine2
MsgBox chaine3
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport1.txt",True)
'FichierTxt.write chaine1
'FichierTxt.Close
'Set FichierTxt = Nothing
'MsgBox "Fait1"
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport2.txt",True)
'FichierTxt.write chaine2
'FichierTxt.Close
'Set FichierTxt = Nothing
'MsgBox "Fait2"
'Set FichierTxt = fso.CreateTextFile(DossProg & "rapport3.txt",True)
'FichierTxt.write chaine3
'FichierTxt.Close
'Set FichierTxt = Nothing
'Set fso = Nothing
'MsgBox "Fait3"
 
'----------------
Dim objExcel, strInput, FichierXlsx
 
strInput = chaine1
FichierXlsx = DossProg & "rapport1.xls"
 
Set objExcel = CreateObject("Excel.Application")
 
Set objWorkbook = objExcel.Workbooks.Open(strInput)
 
objExcel.ActiveWorkbook.SaveAs FichierXlsx, 1
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
 
'FichierTxt.Close
'Set FichierTxt = Nothing
Set fso = Nothing
MsgBox "Fait"

Salut

Moi j'en suis ici

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
'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 ecarts --> 00:19:00
'Maximum = (\d*) pour trouver le temps maximum --> 592
Const ForReading = 1
Dim T, U
Dim DossProg, MonFichierTxt, MonFichierXlsx
Dim FSO, LectureFichierTxt
 
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)
Dim StrFichier, TblDade, TblHeure, TblEcart, TblTmpMax
StrFichier = LectureFichierTxt.ReadAll
LectureFichierTxt.Close
Set LectureFichierTxt = Nothing
 
TblDade = recupTbl("(\d*/\d*/\d*)", StrFichier)  '46
TblHeure = recupTbl("\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*)", StrFichier)  '46
TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier)  ' 46
TblTmpMax = recupTbl("Maximum = (\d*)", StrFichier)  '46
CreatExcel MonFichierXlsx
Set FSO = Nothing
MsgBox "FAIT"
'----------------------------------------------------------------------------------------------------------------------
Function recupTbl(ExpPattern, DansStr)
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, ExcelObject, SheetObject, Ligne1, Ligne2, Cellule1_1, Cellule1_2, Cellule2_1, Cellule2_2
 
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
Set SheetObject = ExcelObject.Workbooks.Add
 
L = 1: C = 66 ' C pour colonnes de 66 à 90  --> A à Z
SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
C = 67
For T = 1 To UBound(TblDade)-1
	If TblDade(T-1) <> TblDade(T) Then
		SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(T))
		C = C + 1
	End If
Next
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing 
ExcelObject.Application.Quit 
Set ExcelObject = Nothing 
End Sub
'----------------------------------------------------------------------------------------------------------------------

Je ne comprends pas trop tes lignes en colonne A.

15/10/2017, 19h35
Invité

Les lignes en colonne A reprennent un cycle de ping par 24H
Si pas de correspondance horaire avec le fichier rapport on laisse vide c’est qu’il n’y a pas eu de problème.
Si correspondance avec le fichier rapport on incrémente la cellule correspondante.
Exemple pour la 1ere détection du fichier rapport :

Citation:

06/10/2017 12:14:59,01
Statistiques Ping pour 192.168.141.10:
Paquets envoyés = 20, reçus = 20, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 592ms, Moyenne = 29ms

La cellule G736 ou G737 serrât incrémenter de la valeur 592 selon l’arrondit choisi.
G pour 06/10/2017
736 pour 12:14:00
737 pour 12:15:00
16/10/2017, 09h52
Invité

Impressionnant, J’avoue que je n’aurais jamais su, voire même pensé coder la gestion des dates de cette maniéré, et en encore moins la fonction "recupTbl"
Je découvre et essaie de comprendre. Là je suis sur les expressions rationnelles "RegExp".
Si tu en as le temps n’hésite pas à commenter un maximum.
Il va me falloir un peu de temps pour digérer ce code, c’est génial, j’adore.

Je ne parviens pas à comprendre la manipulation faite sur les colonnes concernant la récupération des dates : L = 1: C = 66.

Code:

1
2
3
4
5
6
7
8
9
L = 1: C = 66 ' C pour colonnes de 66 à 90  --> A à Z
SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(0)) 'ajout d'un espace pour forcer en string sinon la date est convertie au format anglais mois/jour/date
C = 67
For T = 1 To UBound(TblDade)-1
	If TblDade(T-1) <> TblDade(T) Then
		SheetObject.Sheets(1).Range(Chr(C) & Cstr(L)) = " " & Cstr(TblDade(T))
		C = C + 1
	End If
Next

Une petite explication SVP ?

Salut

Ouf... mais pas des plus satisfais, au niveau du rendu du tableau Excel.

A noter, dans le premier programme (discussion précédente) qui construit le fichier rapport.txt, une modification pour avoir le premier écart en première ligne = "----------- 00:00:00 -----------"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
        If Recup >= 100 Then
            TblLgn = Split(TblChapitre(T), vbNewLine, -1, vbTextCompare) ' découpe en un tableau de chaque ligne du chapitre d'1 Ping
            If chaine = "" Then OldTemps = TblLgn(2)
            DerTemps = TblLgn(2)
            If InStr(OldTemps, ",") Then OldTemps = Left(OldTemps, (InStr(OldTemps, ",") - 1))
            If InStr(DerTemps, ",") Then DerTemps = Left(DerTemps, (InStr(DerTemps, ",") - 1))
            EcartTempo = InterLatence(OldTemps, DerTemps)
            OldTemps = DerTemps
            If chaine <> "" Then chaine = chaine & vbNewLine
            chaine = chaine & "----------- " & EcartTempo & " -----------" & vbNewLine & _
                              DerTemps & vbNewLine & _
                              TblLgn(16) & vbNewLine & _
                              TblLgn(17) & vbNewLine & _
                              TblLgn(19)
'            If chaine <> "" Then chaine = chaine & vbNewLine & "----------- " & EcartTempo & " -----------" & vbNewLine
'            chaine = chaine & DerTemps & vbNewLine & _
'                              TblLgn(16) & vbNewLine & _
'                              TblLgn(17) & vbNewLine & _
'                              TblLgn(19)
        End If

Pour le reste ce

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
'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 ecarts --> 00:19:00
'Maximum = (\d*) pour trouver le temps maximum --> 592
Const ForReading = 1
Dim T, U
Dim DossProg, MonFichierTxt, MonFichierXlsx
Dim FSO, LectureFichierTxt
Dim NomColon
Dim StrFichier, TblDate, TblHeure, TblEcart, TblTmpMax
 
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
 
'*********************************************************
TblDate = recupTbl("(\d*/\d*/\d*)", StrFichier)  '46
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")
'pour date de l'evenement ping, nom de colonne = NomColon(Day(TblDate(T)))
'*********************************************************
TblHeure = recupTbl("\d (\d*:\d*:\d*)|\d  (\d*:\d*:\d*)", StrFichier)  '46
'arrondir l'heure à la minute entiére
For T = 0 To UBound(TblHeure) - 1
    'If TblHeure(T) < 10 Then TblHeure(T) = CDate(TblHeure)
    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")
Next
'pour heure de l'evenement ping, N° de ligne = ((Hour(TblHeure(T))*60) + Minute(TblHeure(T))) + 2
'*********************************************************
TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier)  ' 46
TblTmpMax = recupTbl("Maximum = (\d*)", StrFichier)  '46
CreatExcel MonFichierXlsx
Set FSO = Nothing
MsgBox "FAIT"
'----------------------------------------------------------------------------------------------------------------------
Function recupTbl(ExpPattern, DansStr)
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, Hdeb, ExcelObject, SheetObject
 
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
Set SheetObject = ExcelObject.Workbooks.Add
 
'********************************** Construction de la ligne des jours ***********************************************
L = 1: D = Day(TblDate(0))-1 'decalage des jour pour un raport qui ne commence pas par le jour 1
C = Day(TblDate(0)) - D
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
		C = Day(TblDate(T)) - D
		SheetObject.Sheets(1).Range(NomColon(C) & Cstr(L)) = " " & Cstr(TblDate(T))
	End If
Next
'******************************** construction de la colonne des heures evenements ***********************************
Hdeb= Cdate("00:00:00")
For T = 1 To 1440
	H = DateAdd("n", T-1, Hdeb)
	SheetObject.Sheets(1).Range("A" & Cstr(T+1)) = " " & H 'ajout d'un espace pour forcer en string sinon l'heure est convertie au format anglais
Next
'****************************** placement des temps maxi *************************************************************
L = ((Hour(TblHeure(1)) * 60) + Minute(TblHeure(1))) + 2
For T = 1 To UBound(TblDate) - 1
    C = Day(TblDate(T)) - D
    L = ((Hour(TblHeure(T)) * 60) + Minute(TblHeure(T))) + 2
    SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = TblTmpMax(T) 'ajout d'un espace pour forcer en string sinon l'heure est convertie au format anglais
Next
 
 
SheetObject.SaveAs ChemFichExcel 'Sauve le classeur
SheetObject.Close False 'Ferme le classeur
Set SheetObject = Nothing 
ExcelObject.Application.Quit 
Set ExcelObject = Nothing 
End Sub
'----------------------------------------------------------------------------------------------------------------------

Je commenterai si le résultat du tableau te conviens, mais pour moi il est moins lisible:evilred: que le fichier rapport.txt:whistle2:
C'est la première fois que je pilote Excel en vbScript :aie:

16/10/2017, 20h41
Invité

Bonsoir,
Le premier événement de ping du fichier rapport "Maximum = 592ms" n’est pas prit en compte !
Pour le moment je sèche.

C'est OK, enfin a confirmer par le Maître.
Ligne 98
Remplacer:

Code:

For T = 1 To UBound(TblDate)- 1

Par:

Code:

For T = 0 To UBound(TblDate)- 1
16/10/2017, 23h11
ProgElecT

Salut

Citation:

Envoyé par NeriXs

Bonsoir,
...........
Remplacer par:

Code:

For T = 0 To UBound(TblDate)- 1

:ccool:

Bien vue, cela faisait plus de 2 heures d'affilées que je bricolais sur ce code, fatigue .............
Comme je trouve que la visualisation n'est pas facile, et que les 2 autres boucles For ... Next commence forcement par 1, ayant fait un copier/coller, ben, je n'ai pas fait attention.
De mon humble avis, pour ce tableau, il faudrait trouver une autre architecture pour que cela soit plus claire.

Une autre chose, en l'état, la création du tableau ne peut fonctionné que pour un rapport.txt d'un mois, commençant à x jour du mois et finissant au dernier jour du même mois.
Il doit y avoir une solution, reste à savoir si tu désires conserver ce style de tableau.

A+
16/10/2017, 23h27
Invité

1 pièce(s) jointe(s)

Salut,

Le tableau me convient tout à fait, il est vraie que dans l’état il n’est pas très lisible !
En affichant seulement les horaires qui contiennent des latences sur la période total cela devrait le rendre beaucoup plus lisible non ?
Pour le teste il ne devrait pas durée plus de 15 jours.

Ce que ça donne en supprimant les lignes manuellement :

Pièce jointe 319996
17/10/2017, 13h49
Invité

Salut
Vu que je vais effectuer ce test sur plusieurs machines et ce à divers moments
En gros :
Semaine du 1er au 15 du mois 1 : PC1 vers SRV1
Semaine du 15 au 30 du mois 1 : PC2 vers SRV1
Semaine du 1er au 15 du mois 2 : PC1 vers PC2
Semaine du 15 au 30 du mois 2 : PC1 et PC2 vers SRV1
Semaine du 1er au 15 du mois 3 : SRV1 vers PC1
Semaine du 15 au 30 du mois 3 : SRV1 vers PC2
Semaine du 1er au 15 du mois 4 : SRV1 vers PC1 et PC2
Je reviens sur ma demande de commentaires, dans le but de comprendre au mieux ce code et éventuellement d’être capable d’apporter des modifications mineur le cas échéant.
Modifications éventuelles envisagés :
- Afficher seulement les lignes d’horaires qui contiennent des latences sur la période.
Du xx/xx/2017 au xx/xx/2017
- Adaptation à la période travaillée 8 :00 :00 à 18 : 00 :00.

Salut

Citation:

Je reviens sur ma demande de commentaires, dans le but de comprendre au mieux ce code et éventuellement d’être capable d’apporter des modifications mineur le cas échéant.
Modifications éventuelles envisagés :
- Afficher seulement les lignes d’horaires qui contiennent des latences sur la période.
Du xx/xx/2017 au xx/xx/2017

Je commenterai demain, interessant mais fatigué :aie:, c'est dure la retraite :mouarf1:
Le tableau Excel fait 44 lignes, horaires événements Ping trier du plus petit au plus grand, sur 6 colonnes jours ....
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 '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 ecarts --> 00:19:00 'Maximum = (\d*) pour trouver le temps maximum --> 592 Const ForReading = 1 Dim T, U Dim DossProg, MonFichierTxt, MonFichierXlsx Dim FSO, LectureFichierTxt Dim NomColon Dim StrFichier, TblDate, TblHeure, TblEcart, TblTmpMax 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 '********************************************************* TblDate = recupTbl("(\d*/\d*/\d*)", StrFichier) '46 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") 'pour date de l'evenement ping, nom de colonne = NomColon(Day(TblDate(T))) '********************************************************* TblHeure = recupTbl("\d (\d*:\d*:\d*)|\d (\d*:\d*:\d*)", StrFichier) '46 'arrondir l'heure à la minute entiére For T = 0 To UBound(TblHeure) - 1 'If TblHeure(T) < 10 Then TblHeure(T) = CDate(TblHeure) 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") Next 'pour heure de l'evenement ping, N° de ligne = ((Hour(TblHeure(T))*60) + Minute(TblHeure(T))) + 2 '********************************************************* TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier) ' 46 TblTmpMax = recupTbl("Maximum = (\d*)", StrFichier) '46 CreatExcel MonFichierXlsx Set FSO = Nothing MsgBox "FAIT" '---------------------------------------------------------------------------------------------------------------------- Function recupTbl(ExpPattern, DansStr) 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, Hdeb, ExcelObject, SheetObject 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 Set SheetObject = ExcelObject.Workbooks.Add 'Récupération du classeur par défaut '********************************** Construction de la ligne des jours *********************************************** L = 1: D = Day(TblDate(0)) - 1 'decalage des jour pour un raport qui ne commence pas par le jour 1 C = Day(TblDate(0)) - D 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 C = Day(TblDate(T)) - D SheetObject.Sheets(1).Range(NomColon(C) & CStr(L)) = " " & CStr(TblDate(T)) End If Next '******************************** construction de la colonne des heures evenements *********************************** 'il faut trier les horaires du plus petit au plus grand Dim Dico, HTbl1 'création du variable objet de type Dictionary Set Dico = CreateObject("Scripting.Dictionary") Dico.Add TblHeure(0), "0" '1................ recuperation de tous les horaires sans doublon For T = 1 To UBound(TblHeure) - 1 If Not Dico.Exists(TblHeure(T)) Then Dico.Add TblHeure(T), CStr(T) Next HTbl1 = Dico.Keys Set Dico = Nothing '2................ trier les horaires du plus petit au plus grand 'trier_tableau HTbl1 'http://tahe.developpez.com/web/vbscript/?page=page_5# trier_tableau HTbl1 'Ecriture des horaires evenement dans la colonne A For T = 0 To UBound(HTbl1) - 1 SheetObject.Sheets(1).Range("A" & CStr(T + 2)) = 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 If CDate(SheetObject.Sheets(1).Range("A" & CStr(2 + U))) = H Then C = Day(TblDate(T)) - D SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)) = TblTmpMax(T) End If Next Next 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 '----------------------------------------------------------------------------------------------------------------------
Avec ce fichier rapport.txt

----------- 00:00:00 -----------
06/10/2017 12:14:59,01
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,02
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,02
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,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 106ms, Moyenne = 11ms
----------- 01:22:00 -----------
06/10/2017 14:22:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 625ms, Maximum = 696ms, Moyenne = 661ms
----------- 00:44:00 -----------
06/10/2017 15:06:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 623ms, Maximum = 694ms, Moyenne = 658ms
----------- 00:44:00 -----------
06/10/2017 15:50:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 623ms, Maximum = 710ms, Moyenne = 672ms
----------- 01:34:00 -----------
06/10/2017 17:24:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 114ms, Moyenne = 11ms
----------- 03:05:00 -----------
06/10/2017 20:29:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 250ms, Moyenne = 25ms
----------- 02:15:00 -----------
06/10/2017 22:44:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 180ms, Moyenne = 18ms
----------- 09:22:00 -----------
07/10/2017 12:33:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 168ms, Moyenne = 17ms
----------- 00:11:00 -----------
07/10/2017 14:22:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 135ms, Moyenne = 13ms
----------- 01:32:00 -----------
07/10/2017 9:49:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 201ms, Moyenne = 20ms
----------- 01:33:00 -----------
07/10/2017 11:22:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 132ms, Moyenne = 13ms
----------- 03:14:00 -----------
07/10/2017 14:36:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 203ms, Moyenne = 20ms
----------- 07:35:00 -----------
07/10/2017 22:11:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 120ms, Moyenne = 12ms
----------- 00:10:00 -----------
07/10/2017 22:21:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 292ms, Moyenne = 29ms
----------- 00:07:00 -----------
07/10/2017 22:28:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 280ms, Moyenne = 28ms
----------- 03:31:00 -----------
08/10/2017 1:59:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 112ms, Moyenne = 11ms
----------- 00:16:00 -----------
08/10/2017 2:15:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 214ms, Moyenne = 22ms
----------- 02:44:00 -----------
08/10/2017 4:59:59,00
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 139ms, Moyenne = 14ms
----------- 03:33:00 -----------
08/10/2017 8:32:59,00
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 163ms, Moyenne = 16ms
----------- 02:37:00 -----------
08/10/2017 11:09:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 171ms, Moyenne = 17ms
----------- 05:33:00 -----------
08/10/2017 16:42:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 202ms, Moyenne = 20ms
----------- 00:50:00 -----------
08/10/2017 17:32:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 253ms, Moyenne = 25ms
----------- 07:27:00 -----------
09/10/2017 0:59:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 208ms, Moyenne = 21ms
----------- 01:04:00 -----------
09/10/2017 2:03:59,00
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 121ms, Moyenne = 12ms
----------- 00:29:00 -----------
09/10/2017 2:32:59,00
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 182ms, Moyenne = 19ms
----------- 04:17:00 -----------
09/10/2017 6:49:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 133ms, Moyenne = 14ms
----------- 02:14:00 -----------
09/10/2017 9:03:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 194ms, Moyenne = 77ms
----------- 00:02:00 -----------
09/10/2017 9:05:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 221ms, Moyenne = 174ms
----------- 01:43:00 -----------
09/10/2017 10:48:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 120ms, Moyenne = 12ms
----------- 00:22:00 -----------
09/10/2017 11:10:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 149ms, Moyenne = 15ms
----------- 00:24:00 -----------
09/10/2017 11:34:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 105ms, Moyenne = 10ms
----------- 02:16:00 -----------
09/10/2017 13:50:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 109ms, Moyenne = 10ms
----------- 00:37:00 -----------
09/10/2017 14:27:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 190ms, Moyenne = 30ms
----------- 01:12:00 -----------
09/10/2017 15:39:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 1362ms, Moyenne = 136ms
----------- 02:59:00 -----------
09/10/2017 18:38:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 365ms, Moyenne = 36ms
----------- 00:17:00 -----------
09/10/2017 18:55:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 381ms, Moyenne = 38ms
----------- 00:48:00 -----------
09/10/2017 19:43:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 220ms, Moyenne = 22ms
----------- 02:24:00 -----------
09/10/2017 22:07:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 451ms, Moyenne = 45ms
----------- 00:11:00 -----------
09/10/2017 22:18:59,00
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 1485ms, Moyenne = 148ms
----------- 00:19:00 -----------
09/10/2017 22:37:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 335ms, Moyenne = 33ms
----------- 01:32:00 -----------
10/10/2017 0:09:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 107ms, Moyenne = 10ms
----------- 06:33:00 -----------
10/10/2017 6:42:59,01
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 332ms, Moyenne = 33ms
----------- 01:22:00 -----------
10/10/2017 8:04:59,02
Statistiques Ping pour 192.168.141.10:
Paquetsÿ: envoy‚s = 10, re‡us = 10, perdus = 0 (perte 0%),
Minimum = 0ms, Maximum = 104ms, Moyenne = 11ms

Salut

Correction d'un bug, nettoyage et ajout de commentaires et/ou lien source des parties empruntés.

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
'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
 
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)) - 1 '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 
For T = 0 To UBound(HTbl1) - 1
        SheetObject.Sheets(1).Range("A" & CStr(T + 2)) = 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(2 + U)).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 + 2)) = TblTmpMax(T)
        End If
    Next
Next
 
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

1 pièce(s) jointe(s)

Impeccable Merci pour le travail colossal réalisé et les comS.
Une idée pour utiliser TblEcart.
Excel possède la possibilité de placer un commentaire sur une cellule lorsqu'on la "survol".

Pièce jointe 320422

Code VBA généré automatiquement par Excel :
Code:

1 2 3 4 5 6 Range("C19").AddComment Range("C19").Comment.Visible = False Range("C19").Comment.Text Text:="01 : 33 : 00 " & Chr(10) _ & "écoulée depuis" & Chr(10) _ & "la précédente latence"

18/10/2017, 16h17
ProgElecT

Merci

Citation:

Envoyé par NeriXs

Impeccable Merci pour le travail
.......
Une idée pour utiliser TblEcart.
Excel possède la possibilité de placer un commentaire sur une cellule lorsqu'on la "survol".
.......

Pour aujourd'hui je suis trop occupé, essais de ton coté, j'en ferai autant demain.
A+
18/10/2017, 23h32
Invité

Salut,

Je récupère bien le 1er écart en B2

Code:

SheetObject.Sheets(1).Range("B2").AddComment (TblEcart(1))

Je ne parviens pas à récupérer les cellules correspondant à TblTmpMax(T)

Code:

SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2))

Salut

Il faut déjà libérer la création du tableau TblEcart ligne 40

Code:

1
2
3
'********************** création du tableau écart entre 2 évènements Ping *******************************
TblEcart = recupTbl("- (\d*:\d*:\d*)", StrFichier)
'********************** création du tableau Temps maximum réponse d'un Ping ****************************

Dans la Sub CreatExcel(ChemFichExcel)modifier/ajouter

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
'****************************** 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(2 + U)).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 + 2)) = TblTmpMax(T)
			'ecriture de l'infos bulle
			SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)).AddComment (TblEcart(T) & Chr(10) & "écoulée depuis" & Chr(10) & "la précédente latence ")
			SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)).Comment.Visible = False
		End If
	Next
Next

Il serai intéressant de pouvoir fixer la ligne des dates et la colonne des horaires, car au défilement horizontal et/ou vertical, on perd ces informations.

19/10/2017, 14h53
Invité

Salut,
ARFFFFF, j’y étais presque :

Mon erreur :

Code:

SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)).AddComment = TblEcart(T)

Au lieu de :

Code:

SheetObject.Sheets(1).Range(NomColon(C) & CStr(U + 2)).AddComment TblEcart(T)

Citation:

Envoyé par ProgElecT

Salut
Il serai intéressant de pouvoir fixer la ligne des dates et la colonne des horaires, car au défilement horizontal et/ou vertical, on perd ces informations.

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

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