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
| Option Explicit
Public MonTXT As String
Sub Lire_Fichier()
Dim Extract As String
Dim Tableau_Extraction As Variant
Dim CheminTXT As String
Dim SansTotal As Integer
CheminTXT = ActiveWorkbook.Path & "\TEXT\"
MonTXT = Dir(CheminTXT & "*.txt")
While MonTXT <> ""
Open CheminTXT & MonTXT For Input As #1
Line Input #1, Extract
SansTotal = 0
While Not EOF(1)
If InStr(Extract, " CRED I") > 0 Then
Tableau_Extraction = Split(Extract, "I")
If SansTotal < 11 Then 'Cette condition permet d'exclure le total du fichier analysé
SansTotal = SansTotal + 1
Call Ecriture_Excel(Tableau_Extraction, SansTotal)
End If
End If
Line Input #1, Extract
Wend
If SansTotal = 11 Then
SansTotal = 0
End If
Close #1
MonTXT = Dir()
Wend
End Sub
Sub Ecriture_Excel(Tableau_Extraction As Variant, SansTotal)
Dim i_tab As Long
Dim Derniere_Ligne As Long
Dim Apur1 As Currency
Dim Apur2 As Currency
Dim Apur3 As Currency
Dim TabApurP(5) As String
Dim TabApurA(5) As String
Derniere_Ligne = Cells(Rows.Count, 1).End(xlUp).Row
Derniere_Ligne = IIf(Cells(1, 1) = "", 1, Derniere_Ligne + 1)
i_tab = 2
Do
If i_tab - 1 = 1 Then
ActiveSheet.Cells(Derniere_Ligne, i_tab - 1) = CDbl(Trim(Tableau_Extraction(i_tab))) ' A supprimer
Apur1 = CDbl(Trim(Tableau_Extraction(i_tab)))
i_tab = i_tab + 1
ElseIf i_tab - 1 = 2 Then
ActiveSheet.Cells(Derniere_Ligne, i_tab - 1) = CDbl(Trim(Tableau_Extraction(i_tab))) ' A supprimer
Apur2 = CDbl(Trim(Tableau_Extraction(i_tab)))
i_tab = i_tab + 1
ElseIf i_tab - 1 = 3 Then
ActiveSheet.Cells(Derniere_Ligne, i_tab - 1) = CDbl(Trim(Tableau_Extraction(i_tab))) ' A supprimer
Apur3 = CDbl(Trim(Tableau_Extraction(i_tab)))
i_tab = i_tab + 1
End If
Loop While i_tab <= UBound(Tableau_Extraction) - 2
Dim VarTab As String
Call TypeI(SansTotal, VarTab)
TabApurP(0) = Mid(MonTXT, 8, 6)
TabApurP(1) = 0
TabApurP(2) = Apur1
TabApurP(3) = VarTab
TabApurP(4) = "Précédent"
TabApurP(5) = "E"
Dim ResultTabApurP As String
ResultTabApurP = TabApurP(0) & ";" & TabApurP(1) & ";" & TabApurP(2) & ";" & TabApurP(3) & ";" & TabApurP(4) & ";" & TabApurP(5)
If Apur1 > 0 Then
Call EnregistrerAction(ResultTabApurP)
End If
TabApurA(0) = Mid(MonTXT, 8, 6)
TabApurA(1) = 0
TabApurA(2) = Apur2 + Apur3
TabApurA(3) = VarTab
TabApurA(4) = "Antérieur"
TabApurA(5) = "E"
Dim ResultTabApurA As String
ResultTabApurA = TabApurA(0) & ";" & TabApurA(1) & ";" & TabApurA(2) & ";" & TabApurA(3) & ";" & TabApurA(4) & ";" & TabApurA(5)
If Apur2 + Apur3 > 0 Then
Call EnregistrerAction(ResultTabApurA)
End If
End Sub
Sub TypeI(SansTotal, VarTab)
Dim x As Integer
x = SansTotal
Select Case x
Case 1: VarTab = "AA"
Case 2: VarTab = "BB"
Case 3: VarTab = "CC"
Case 4: VarTab = "DD"
Case 5: VarTab = "EE"
Case 6: VarTab = "FF"
Case 7: VarTab = "GG"
Case 8: VarTab = "HH"
Case 9: VarTab = "II"
Case 10: VarTab = "JJ"
Case 11: VarTab = "LL"
End Select
End Sub |
Partager