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 159 160 161 162 163 164
| Sub Import_Euromaster_6()
Dim ligne As String
Dim NbLigne As Long
Dim i As Long
Dim r As Long
Dim StartTab1 As Long
Dim EndTab1 As Long
Dim mon_tableau() As String
Dim MaRef As Variant
Dim MaDeal As Variant
On Error GoTo Err
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks.OpenText Filename:="D:\Euromaster\Source\*.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
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:="D:\Euromaster\Source\import.txt", FileFormat:= _
xlText, CreateBackup:=False
SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
ActiveWorkbook.Save
ActiveWindow.Close
Range("A1").Select
Open ("D:\Euromaster\Source\import.txt") For Input As #1
Do While Not EOF(1) '---> premiere boucle qui compte toutes les lignes du document
Input #1, ligne
NbLigne = NbLigne + 1
Loop
Close #1
Open ("D:\Euromaster\Source\import.txt") For Input As #2 '---> ouverture du fichier en lecture
i = 1 '---> declaration des variables
StartTab = 1
EndTab = 0
ReDim mon_tableau(NbLigne, 10) '---> initialisation d'un tableau de X lignes et 9 colonnes
Do While Not EOF(2) '---> debut de la seconde boucle
Input #2, ligne
If Left(ligne, 7) <> "" Then '---> les 7 premiers caracteres de la ligne sont differents de vide
MaRef = Left(ligne, 7)
If IsNumeric(MaRef) Then '---> les 7 premiers caracteres sont numeriques
If Len(ligne) > 70 Then '---> la ligne des 7 premiers caracteres comporte plus de 50 caracteres
mon_tableau(i, 1) = Mid$(ligne, 1, 7) & "0000" '---> je recupere les informations dans un tableau
mon_tableau(i, 2) = Mid$(ligne, 20, 7)
mon_tableau(i, 3) = Mid$(ligne, 76, 1)
mon_tableau(i, 6) = "zta"
mon_tableau(i, 7) = "43"
mon_tableau(i, 8) = "RE"
mon_tableau(i, 9) = "0"
i = i + 1
EndTab = EndTab + 1
End If
End If
End If
If Left(ligne, 18) = "NUMERO DE COMMANDE" Then '---> test sur numerro de commande
For r = StartTab To EndTab
mon_tableau(r, 4) = Mid$(ligne, 34, 3) '---> 3 premiers caractères du Purch. Order = Code Dealer
Sheets("SAP").Select '---> correspondance entre Code Dealer (.xls) et Sold To Party (SAP)
Columns("A:A").Select
With Selection.Find(Mid$(ligne, 34, 3)).Activate
On Error GoTo Err
End With
mon_tableau(r, 4) = ActiveCell.Value
mon_tableau(r + 1, 10) = ActiveCell.Offset(0, 1).Value
Sheets("RDCNORD").Select
Next r
For r = StartTab To EndTab
mon_tableau(r, 5) = Mid$(ligne, 34, 3) & Mid$(ligne, 37, 4) '---> Purch. Order complet
Next r
StartTab = EndTab + 1
End If
Loop
Close #2
For r = 1 To EndTab
Cells(r + 1, 1).Value = mon_tableau(r, 6) '---> Sales doc. type
Cells(r + 1, 2).Value = mon_tableau(r, 7) '---> Sales org.
Cells(r + 1, 3).Value = mon_tableau(r, 8) '---> Distr. Channel
Cells(r + 1, 4).Value = mon_tableau(r, 9) '---> Division
Cells(r + 1, 5).Value = mon_tableau(r + 1, 10) '---> Conversion Code Dealer / Sold to Party
Cells(r + 1, 6).Value = mon_tableau(r, 1) '---> Material
Cells(r + 1, 7).Value = mon_tableau(r, 2) '---> Customer Material
Cells(r + 1, 8).Value = mon_tableau(r, 3) '---> Quantity
Cells(r + 1, 10).Value = mon_tableau(r, 5) '---> Purch. Order complet
Next r
Application.DisplayAlerts = False
Range("A1").Select
Sheets("RDCNORD").Select '---> Selection de la page RDCNORD
Selection.CurrentRegion.Select '---> Selection de la plage
Selection.Copy
Workbooks.Add
ActiveSheet.Paste '---> Copie de la plage dans un nouveau classeur et nouvelle page
ActiveSheet.Rows.AutoFit '---> Ajustement automatique des lignes et colonnes du tableau
ActiveSheet.Columns.AutoFit
Sheets("Feuil2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Feuil3").Select
ActiveWindow.SelectedSheets.Delete
jour = Day(Now) & "_" & Month(Now) & "_" & Year(Now) '---> Declaration d'une variable jour
monfichier = "D:\Euromaster\Incoming\" & "Euromaster_" & jour '---> Creation du classeur a endroit precis
ActiveSheet.Name = "Euromaster_" & jour
If Dir(monfichier & ".xls") <> "" Then '---> Verification si classeur existe deja
MsgBox ("Un fichier IMPORT existe déjà, veuillez le supprimer/déplacer avant nouvelle copie")
Else
monfichier = monfichier & ".xls" '---> Classeur inexistant = creation classeur
ActiveWorkbook.SaveAs Filename:= _
monfichier, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.Close SaveChanges:=True '---> Fermeture automatique du nouveau classeur
MsgBox ("Fichier d'import Euromaster créé dans D:\Euromaster\Incoming\")
End If
'<<<<<<<<<<<< J'AI FAIS MES TESTS A CET ENDROIT >>>>>>>>>>>'
Kill ("D:\Euromaster\Source\import.txt")
Kill ("D:\Euromaster\Source\*.doc")
Application.DisplayAlerts = False
Application.Quit
Exit Sub
Err: MsgBox ("Aucune corresponce SAP pour le Code Dealer:" & Mid$(ligne, 34, 3) & vbCrLf & "Vérifier que le Code Dealer est bien référencé dans SAP")
SetAttr ("D:\Euromaster\Source\import.txt"), vbHidden
Kill ("D:\Euromaster\Source\*.doc")
Application.Quit
End Sub |
Partager