Option Explicit
Private Function Chemin(ByVal sFichier As String) As String
Dim i As Integer
Dim sChemin As String
sChemin = ""
If Dir$(sFichier) = "" Then Exit Function
For i = 0 To UBound(Split(sFichier, "\" )) - 1
sChemin = sChemin & Split(sFichier, "\" )(i) & "\"
Next i
Chemin = sChemin
End Function
Private Sub Correction(ByVal sNomFichier As String)
Dim sIn As String
Dim sOut As String
Dim iNumFichier1 As Integer, iNumFichier2 As Integer
Dim sNomFichier2 As String, sCheminFichier As String
Close
sCheminFichier = Chemin(sNomFichier)
sNomFichier2 = sCheminFichier & "Corr_" & NomDuFichier(sNomFichier)
iNumFichier1 = FreeFile
Open sNomFichier For Input As #iNumFichier1
iNumFichier2 = FreeFile
Open sNomFichier2 For Output As #iNumFichier2
Do While Not EOF(iNumFichier1)
Line Input #iNumFichier1, sIn
Select Case Mid$(sIn, 8, 4)
Case "0400"
sOut = Left$(sIn, 32) & "07" & Mid$(sIn, 35)
Print #iNumFichier2, sOut
Case "6800"
sOut = Left$(sIn, 32) & "62" & Mid$(sIn, 35)
Print #iNumFichier2, sOut
Case "3800"
sOut = Left$(sIn, 32) & "40" & Mid$(sIn, 35)
Print #iNumFichier2, sOut
End Select
Loop
Close #iNumFichier2
Close #iNumFichier1
End Sub
Private Function NomDuFichier(ByVal sFichier As String) As String
With CreateObject("Scripting.FileSystemObject" )
On Error Resume Next
NomDuFichier = .GetFileName(sFichier)
On Error GoTo 0
End With
End Function
Sub SelectionTXT()
Dim Fichier As Variant
Dim i As Long
ChDir ThisWorkbook.Path
Fichier = Application.GetOpenFilename("Fichier TXT (*.txt), *.txt", , "Sélectionner un ou plusieurs fichier(s)", , True)
If TypeName(Fichier) = "Boolean" Then Exit Sub
For i = 1 To UBound(Fichier)
Correction Fichier(i)
Next i
End Sub