msauvegrain
XLDnaute Nouveau
Bonsoir,
Une petite macro en VB, sur une base développée par Job75, j'ai le problème suivant certains fichiers ne sont pas bien traités.
Des Guillemets sont ajoutés par deux ou trois dans le fichier de retour.
En exemple le fichier à traiter et les deux fichiers de retour.
Je ne vois pas où est le problème, et de plus ça marche avec d'autres fichiers sans problèmes
Merci de votre aide.
@+, Michel
Une petite macro en VB, sur une base développée par Job75, j'ai le problème suivant certains fichiers ne sont pas bien traités.
Des Guillemets sont ajoutés par deux ou trois dans le fichier de retour.
En exemple le fichier à traiter et les deux fichiers de retour.
Je ne vois pas où est le problème, et de plus ça marche avec d'autres fichiers sans problèmes
Merci de votre aide.
@+, Michel
VB:
Sub Traitement_dossiers()
Dim dossier1$, dossier2, remplace, par, chemin$, fichier$, n&, i, nom$, j, k, m, p, r, s
dossier1 = "CSV\" 'nom du sous-dossier, modifiable
dossier2 = "XLS\" 'nom du sous-dossier, modifiable
remplace = Array("é", "É", "Ã~¨", "â", "½") 'liste modifiablee
par = Array("é", "É", "è", "â", "½") 'liste modifiable
n = 0
'---sélection du dossier---
ChDir ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFolderPicker) 'sélection du dossier
If .Show = False Then Exit Sub
chemin = .SelectedItems(1) & "\"
End With
'---création des sous-dossiers---
If Dir(chemin & dossier1, vbDirectory) = "" Then MkDir chemin & dossier1
If Dir(chemin & dossier2, vbDirectory) = "" Then MkDir chemin & dossier2
'---traitement des fichiers csv---
fichier = Dir(chemin & "*.csv") '1er fichier csv du dossier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si les fichiers sont déjà créés
While fichier <> ""
n = n + 1
Workbooks.OpenText chemin & fichier, TextQualifier:=xlTextQualifierDoubleQuote, Comma:=True, DecimalSeparator:=".", Local:=True
With ActiveWorkbook.Sheets(1)
.Rows("1:6").Delete
.Range("A1").Value = "Nom"
.Range("B1").Value = "Pays"
.Range("C1").Value = "Séries"
.Range("D1").Value = "Nums"
.Range("E1").Value = "Date d_émission"
.Range("F1").Value = "Date d_expiration"
.Range("G1").Value = "Largeur"
.Range("H1").Value = "Height"
.Range("I1").Value = "Papier"
.Range("J1").Value = "Filigrane"
.Range("K1").Value = "Émission"
.Range("L1").Value = "Format"
.Range("M1").Value = "Dentelure"
.Range("N1").Value = "Impression"
.Range("O1").Value = "Gomme"
.Range("P1").Value = "Monnaie"
.Range("Q1").Value = "FaceValue"
.Range("R1").Value = "Tirage"
.Range("S1").Value = "Variétés"
.Range("T1").Value = "Pointage"
.Range("U1").Value = "Pertinence"
.Range("V1").Value = "Couleurs"
.Range("W1").Value = "Thèmes"
.Range("X1").Value = "Description"
.Range("Y1").Value = "Lien"
i = .Range("A" & .Rows.Count).End(xlUp).Row
.Rows(IIf(i < 3, 1, i - 2)).Resize(3).Delete '3 dernières lignes
For i = 0 To UBound(par)
.Cells.Replace remplace(i), par(i), xlPart
Next i
nom = Replace(fichier, "fr_stamps_csv_list_country_", "")
nom = Replace(fichier, ".csv", "")
j = InStr(nom, "-")
nom = Mid(nom, j + 1)
m = InStr(nom, "C38E")
nom = IIf(m, (Replace(nom, "C38E", "I")), nom)
m = InStr(nom, "C389")
nom = IIf(m, (Replace(nom, "C389", "É")), nom)
m = InStr(nom, "C3A9")
nom = IIf(m, (Replace(nom, "C3A9", "é")), nom)
m = InStr(nom, "C3AE")
nom = IIf(m, (Replace(nom, "C3AE", "I")), nom)
m = InStr(nom, "C3B4")
nom = IIf(m, (Replace(nom, "C3B4", "o")), nom)
m = InStr(nom, "C3A8")
nom = IIf(m, (Replace(nom, "C3A8", "è")), nom)
m = InStr(nom, "C3AF")
nom = IIf(m, (Replace(nom, "C3AF", "ï")), nom)
m = InStr(nom, "C3A7")
nom = IIf(m, (Replace(nom, "C3A7", "ç")), nom)
m = InStr(nom, "_C3A0_")
nom = IIf(m, (Replace(nom, "C3AE", "_")), nom)
m = InStr(nom, "C3A0")
nom = IIf(m, (Replace(nom, "C3A0", "_")), nom)
m = InStr(nom, "C3BC")
nom = IIf(m, (Replace(nom, "C3BC", "ü")), nom)
m = InStr(nom, "_-_")
nom = IIf(m, (Replace(nom, "_-_", "_")), nom)
m = InStr(nom, "-")
nom = IIf(m, (Replace(nom, "-", "_")), nom)
.SaveAs chemin & dossier1 & nom & ".csv", 6 'format csv
nom = "X_" & nom
.SaveAs chemin & dossier2 & nom & ".xls", 56 'format xls
End With
ActiveWorkbook.Close
fichier = Dir 'fichier suivant
Wend
MsgBox IIf(n, n & " fichier" & IIf(n = 1, "", "s") & " CSV traité" & IIf(n = 1, "...", "s..."), "Aucun fichier CSV trouvé...")
End Sub