Super merci ça marche, les 2 façons j'ai aussi modifié l'autre code. Je commence à comprendre la logique des tableaux mais c'est pas évident. Les voilà dont un on je suis en train de rajouter les erreurs.
Je te remercie de ton aide.
*********************************Premier*************************************
Private Sub transfert_Click()
Dim ColA()
Dim ColB()
Dim ColC()
Dim ColD()
Dim ColE()
Dim ColF()
Dim Nb As Long
Nb = 1
Dim Temp As String
Dim Nombre As String
'Recupération des données renseigner par l'opérateur
G_CheminFichier = TXT_Chemin_Fichier.Text
G_NomFichier = TXT_Nom_Fichier.Text
G_NomFichierText = TXT_Nom_Fichier_Texte.Text
'lecture, stockage, recup dans tableau
Open G_CheminFichier & G_NomFichier For Input As #1
Do While Not EOF(1)
Line Input #1, Temp
'si la ligne commence par AT extraction des chiffre en ()
If Mid(Temp, 1, 2) = "AT" Then
'If Left(Temp, 2) = "AT" Then
Dim PosDep As Integer
Dim PosFin As Integer
Dim t As Integer
PosDep = InStr(1, Temp, "(", vbTextCompare)
PosFin = InStr(PosDep, Temp, ")", vbTextCompare)
Nombre = Mid(Temp, PosDep + 1, PosFin - PosDep - 1)
If Nb = 1999 Then
Dim toto As Integer
toto = 1
End If
t = Nb
Text1.Text = t
Select Case Nb
Case 1 To 1000
ReDim Preserve ColA(Nb - 1)
ColA(Nb - 1) = Nombre
Case 1001 To 2000
ReDim Preserve ColB(Nb - 1 - 1000)
ColB(Nb - 1 - 1000) = Nombre
Case 2001 To 3000
ReDim Preserve ColC(Nb - 1 - 2000)
ColC(Nb - 1 - 2000) = Nombre
Case 3001 To 4000
ReDim Preserve ColD(Nb - 1 - 3000)
ColD(Nb - 1 - 3000) = Nombre
Case 4001 To 5000
ReDim Preserve ColE(Nb - 1 - 4000)
ColE(Nb - 1 - 4000) = Nombre
Case 5001 To 6000
ReDim Preserve ColF(Nb - 1 - 5000)
ColF(Nb - 1 - 5000) = Nombre
End Select
Nb = Nb + 1
End If
Loop
Close #1
'Test de la valeur
Dim valeurLimite As Long
valeurLimite = UBound(ColA)
If (valeurLimite <> UBound(ColB)) Or (valeurLimite <> UBound(ColC)) Or _
(valeurLimite <> UBound(ColD)) Or (valeurLimite <> UBound(ColE)) Then
'Gestion erreur
MSg = "Valeur pas valide"
MsgBox (MSg)
End
End If
'écriture du fichier dans nouveau fichier
Open ("D:\essai2.text") For Output As #1
Print #1, ("Num pts;U Alt; I Alt; % PID; U Exi;I Ext")
For i = 0 To UBound(ColA)
On Error Resume Next 'au cas ou il y a pas 5000 entré d extraite du fichier
Print #1, ColA(i) & ";" & ColB(i) & ";" & ColC(i) & ";" & ColD(i) & ";" & ColE(i) & ";"
Next i
Close #1
MSg = "fin"
MsgBox (MSg)
*******************************************Deuxième********************************
Dim Msg 'message de réussite
Dim i, Mypo, Mypo2, NbCar As Integer
Dim C, ReadC As String
Dim t, y As String
Dim Montableau(0 To 5, 0 To 999) As String
Dim chaine As Variant
Dim TailleFichierTexte, EcrasementFichier, ExistanceFichier As String 'renvoie la taille du fichier Texte
Dim TXT As String 'envoie l'extantion du fichier texte d'origine
'on récupére les données inscritent par l'utilisateur
G_CheminFichier = TXT_Chemin_Fichier.Text
G_NomFichier = TXT_Nom_Fichier.Text
G_NomFichierText = TXT_Nom_Fichier_Texte.Text
'vérification de lafin du fichier du chemin qui doit finir pa "\"
'TailleFichierTexte = Trim(G_CheminFichier)
'TailleFichierTexte = Len(G_CheminFichier)
'Dans le cas ou rien n'est écrit on va au message erreur
'If TailleFichierTexte = "0" Then GoTo fin1
'TXT = Mid(G_CheminFichier, TailleFichierTexte)
'Si l 'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur
'If TXT <> "\" Then GoTo fin2
' Verification que le fichier texte d'origine à une extantion .TXT ou .txt
'TailleFichierTexte = Trim(G_NomFichier)
' TailleFichierTexte = Len(G_NomFichier)
' If TailleFichierTexte = "0" Then GoTo fin3
' TXT = Mid(G_NomFichier, TailleFichierTexte - 3)
'Si l'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur
'If TXT <> ".txt" And TXT <> ".TXT" Then GoTo fin4
'Si l'extantion n'est pas correcte alors on arrete et on affiche un message d'erreur
'If TXT <> ".txt" And TXT <> ".TXT" And TXT <> ".dat" And TXT <> ".DAT" And TXT <> ".doc" And TXT <> ".DOC" Then GoTo fin2
' Verification que le fichier destination n'existe pas encore pour eviter d'ecraser des données
'EcrasementFichier = Dir(G_CheminFichier & G_NomFichier)
'If EcrasementFichier = G_NomFichierText Then GoTo fin6
'ExistanceFichier = Dir(G_CheminFichier & G_NomFichier)
'If ExistanceFichier = "" Then GoTo fin5
' Verication que le fichier texte de destination à une extantion .TXT ou .txt ou .DAT ou .dat ou .DOC ou .doc
'TailleFichierTexte = Trim(G_NomFichierText)
'TailleFichierTexte = Len(G_NomFichierText)
'If TailleFichierTexte = "0" Then GoTo fin3
'TXT = Mid(G_NomFichierText, TailleFichierTexte - 3)
'Lecture
If G_NomFichier <> "" Then
'ouverture du fichier source
Open G_CheminFichier + G_NomFichier For Input As #1
'boucle sur 5000 lignes
i = 0
Do While i < 5000
'gestion d'erreur si moins de 5000 lignes
On Error Resume Next
Line Input #1, ReadC
If Err.Number <> 0 Then
Err.Clear
Exit Do
End If
'extraction de la valeur
If Left(ReadC, 2) = "AT" Then
Mypo = InStr(1, ReadC, "(")
Mypo2 = InStr(1, ReadC, ")")
NbCar = Mypo2 - Mypo
C = Mid(ReadC, Mypo + 1, NbCar - 1)
'mise de la valeur dans un tableau en fonction du numéro de la ligne
If i <= 999 Then
Montableau(0, i) = C
ElseIf i <= 1999 Then
Montableau(1, i - 1000) = C
ElseIf i <= 2999 Then
Montableau(2, i - 2000) = C
ElseIf i <= 3999 Then
Montableau(3, i - 3000) = C
ElseIf i <= 4999 Then
Montableau(4, i - 4000) = C
End If
'comptage du nombre valeurs extraite et affichage
i = i + 1
t = i
Text3.Text = t
End If
Loop
For i = 0 To 999 'conétation des valeurs du tableau dans une chaine
chaine = chaine & CStr(Montableau(0, i)) & ";" & CStr(Montableau(1, i)) & ";" & CStr(Montableau(2, i)) & ";" & CStr(Montableau(3, i)) & ";" & CStr(Montableau(4, i)) & vbCrLf
Next i
Close #1
Text1.Text = chaine
'ecriture dans le nouveau fichier
Open ("D:\Name.text") For Output As #1
Print #1, ("Num pts;U Alt; I Alt; % PID; U Exi;I Ext")
Print #1, chaine
Close #1
End If
Msg = ("FIN")
MsgBox (Msg)
fin1:
MsgBox "Veuillez entrer le chemin du fichier d'origine"
Command1.Enabled = True
Exit Sub
fin2:
MsgBox "Le chemin doit finir par le caractère \ , Exemple: C:\Program Files\ "
Command1.Enabled = True
Exit Sub
fin3:
MsgBox "Veuillez entrer le nom du fichier d'origine"
Command1.Enabled = True
Exit Sub
fin4:
MsgBox " Le nom du fichier saisi dans le champ 'Nom du fichier source .TXT' est faux, veuillez saisir par exemple 'essai.txt'"
Command1.Enabled = True
Exit Sub
fin5:
MsgBox "AucunFichier"
Command1.Enabled = True
Exit Sub
fin6:
MsgBox "EcrasementFichier"
Command1.Enabled = True
Exit Sub
@+CV
