DefInt I
DefByte B
DefVar V
DefLng L
DefStr S
Private Sub Workbook_Open()
Dim tabstrTableau() As Variant
vFiles = Application.GetOpenFilename('Equipement file (*.*),*.*', , 'Titre', , True)
For Each vFile In vFiles
iFileNo = FreeFile
Open vFile For Input As #iFileNo
' Boucle pour compter le nombre de ligne qui va servir a redimentionner la variable tabstrTableau() qui elle à sont tour va servir a conserver
' seulement les lignes qui ont 9006, 9007, 90008 comme erreur de code
While Not EOF(iFileNo)
Line Input #iFileNo, sInfoLigne
sInfoLigne = Trim(sInfoLigne)
Select Case Left(sInfoLigne, InStr(sInfoLigne, Chr(32)) - 1)
Case 9006, 9007, 90008
lLines = lLines + 1
End Select
Wend
ReDim Preserve tabstrTableau(lLines, 11)
' referme le fichier pour ensuite le re-ouvrir et mettre dans la variable seulement les lignes qui ont 9006, 9007, 90008 comme erreur de code
Close iFileNo = FreeFile
Workbooks.Add
iFileNo = FreeFile
Open vFile For Input As #iFileNo
lLines = 0
lLoop = 0
While Not EOF(iFileNo)
Line Input #iFileNo, sInfoLigne ' Lit la Xième ligne du fichier
sInfoLigne = Trim(sInfoLigne) 'supprime les espaces au début et à la fin de la ligne
Select Case Left(sInfoLigne, InStr(sInfoLigne, Chr(32)) - 1) ' Lit le début de la ligne (Le code d'erreur)
Case 9006, 9007, 90008
Do
sInfoLigne = Trim(sInfoLigne)
tabstrTableau(lLines, lLoop) = Mid(sInfoLigne, 1, InStr(sInfoLigne, Chr(32)) - 1)
sInfoLigne = Mid(sInfoLigne, InStr(sInfoLigne, Chr(32)) + 1)
lLoop = lLoop + 1
Loop Until InStr(sInfoLigne, Chr(32)) = 0 Or Left(sInfoLigne, 4) = ' I'
If Not Left(sInfoLigne, 4) = ' I' Then ' Rajouter cette partie parce que certaine ligne finissait avec ' IIII'
tabstrTableau(lLines, lLoop) = sInfoLigne
End If
lLines = lLines + 1
'If lLines = 52 Then Stop
lLoop = 0
End Select
'If la = 285 Then Stop
Wend
Range(Cells(1, 1), Cells(lLines + 1, 11)) = tabstrTableau
'Tu pourrais rajouter ton code pour tes TCD ici ou faire autrement. A ton choix.
Next vFile
End Sub
