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

Version imprimable

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 ?
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.