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
|
Sub QStat(ByVal Source As String, ByVal L As Long, ByRef Msg As String)
Dim num1 As Integer
Dim num2 As Integer
Dim diff As Integer
Dim intFic As Integer
Dim strLigne As String
Dim detect As Boolean
Dim strCount As String
Dim NomFichier As String
Dim Position As Integer
Dim i As Integer
Dim Tableau() As String
i = 3
' On passe à l'affichage
'Entete
ThisWorkbook.Sheets(1).Cells(1, 1) = "REFERENCE"
ThisWorkbook.Sheets(1).Cells(1, 2) = "SERIAL NUM"
ThisWorkbook.Sheets(1).Cells(1, 3) = "STEP TEST :"
'affectation du repertoire
'detect : Variable de controle de fichier
detect = True
intFic = FreeFile
'--------Recupération nom fichier----------------------------
Position = InStrRev(Source, "\")
If Position = 0 Then
NomFichier = Source
Else
NomFichier = Mid(Source, Position + 1)
'Pour enlever l'extension, on cherche le dernier point
Position = InStrRev(NomFichier, ".")
'Si on le trouve, on ne garde que ce qui précède
If Position <> 0 Then
NomFichier = Mid(NomFichier, 1, Position - 1)
End If
End If
'--------Fin Recupération nom fichier-------------------------
'ouverture du fichier
Open Source For Input As intFic
While Not EOF(intFic) And detect
detect = False
Line Input #intFic, strLigne
If Left(strLigne, 3) = "EV|" Then
'Controle sur le Event
'Nbre |
num1 = Len(strLigne)
strCount = Replace(strLigne, "|", "")
num2 = Len(strCount)
diff = num1 - num2
If diff = 35 Then
detect = True
Else
Msg = Msg & vbNewLine & "Error in the " & NomFichier & " file, EV field contains " & diff & " | instead of 35"
detect = False
'Exit Sub
End If
End If
If Left(strLigne, 3) = "ME|" Then
'Controle sur la mesure
'Nbre |
num1 = Len(strLigne)
strCount = Replace(strLigne, "|", "")
num2 = Len(strCount)
diff = num1 - num2
If diff = 19 Then
detect = True
Else
Msg = Msg & vbNewLine & "Error in the " & NomFichier & " file, ME field contains " & diff & " | instead of 19"
detect = False
'Exit Sub
End If
End If
If Left(strLigne, 3) = "TD|" Then
'Controle sur les limites
'Nbre |
num1 = Len(strLigne)
strCount = Replace(strLigne, "|", "")
num2 = Len(strCount)
diff = num1 - num2
If diff = 18 Then
detect = True
Else
Msg = Msg & vbNewLine & "Error in the " & NomFichier & " file, TD contains " & diff & " | instead of 18"
detect = False
'Exit Sub
End If
End If
Wend
Close intFic
If detect = True Then
intFic = FreeFile
'ouverture du fichier
Open Source For Input As intFic
While Not EOF(intFic)
Line Input #intFic, strLigne
If Left(strLigne, 3) = "ME|" Then
'on incrémente la ligne d'ecriture
i = i + 1
'on decompose
Tableau = Split(strLigne, "|")
'on ecrit
ThisWorkbook.Sheets(1).Cells(1, i) = Tableau(4)
ThisWorkbook.Sheets(1).Cells(L, 1) = Tableau(1)
ThisWorkbook.Sheets(1).Cells(L, 2) = Tableau(2)
ThisWorkbook.Sheets(1).Cells(L, i) = Tableau(6)
End If
Wend
End If
Close intFic 'fermeture fichier
End Sub |
Partager