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
| Sub Import_Euromaster()
Dim numcmd As String
Dim ref As String
Dim qte As String
Dim cust_mat As String
Dim i As Integer
Dim mon_tableau() As String
Close #1
Application.ScreenUpdating = True
Workbooks.OpenText Filename:="D:\8 - Projet VB_CMD\test.doc", Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True
Columns("A:A").EntireColumn.AutoFit
ActiveWorkbook.SaveAs Filename:="D:\8 - Projet VB_CMD\test.txt", FileFormat:= _
xlText, CreateBackup:=False
ActiveWorkbook.Save
ActiveWindow.Close
Range("A2").Select
Open ("D:\8 - Projet VB_CMD\test.txt") For Input As #1 '--------------------------------> ouverture du fichier en lecture
While Not EOF(1) '----------------------------------------------------------------------> demarrage de la boucle pour lecture du fichier
lign$ = "" '------------------------------------------------------------------------> initialisation d une variable à ""
Line Input #1, lign$ '--------------------------------------------------------------> lire une ligne du fichier et passage à la ligne suivante (et affactation dans une variable chaine)
toto = 0
While InStr(1, lign$, "NUMERO DE COMMANDE A RAPPELER :") <> 0 '---------------> test sur le numero de commande
numcmd$ = Mid$(lign$, 34, 7) '----------------------------------------------> extraction du numero de commande
If InStr(1, lign$, "REF.FABRIQUANT") <> 0 Then '----------------------------> test sur la ref,cust mat et qte
lign$ = lign$ & vbCrLf '------------------------------------------------> formule sauter 2 lignes
Line Input #1, lign$
lign$ = lign$ & vbCrLf
Line Input #1, lign$
ref$ = Mid$(lign$, 1, 7) '----------------------------------------------> extraction de la ref
ref_new_format = Mid$(ref$, 1, 7) & "0000"
qte$ = Mid$(lign$, 76, 1) '---------------------------------------------> extraction de la qte
cust_mat$ = Mid$(lign$, 20, 7) '----------------------------------------> extraction du cust mat
toto = toto + 1
End If
For i = 1 To toto
ReDim Preserve mon_tableau(i)
mon_tableau(1) = numcmd$
ReDim mon_tableau(2)
mon_tableau(2) = ref$
ReDim mon_tableau(3)
mon_tableau(3) = qte$
ReDim mon_tableau(4)
mon_tableau(4) = cust_mat$
Next i
Wend
Wend '--------------------------------------------------------------------------------------> fin boucle
Close #1 '-----------------------------------------------------------------------------> fermeture du fichier
End Sub |
Partager