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 |
Partager