Traitement CSV et enregistrement en XLS

Version imprimable

Bonjour,

Je n'arrive pas à trouver une solution à ma situation:

Le départ :arrow: J'ai une suite de fichiers CSV. Pour chacun d'eux, je voudrais faire quelques traitements automatisés (mettre en forme, remplacer des caractères non voulus, convertir des données dans un bon format, etc.) et enregistrer le résultat dans un nouveau répertoire au format XLS.

Le traitement :arrow: Mon traitement de mise en forme est le suivant :

Code:

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
Sub Traitement()
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1)), TrailingMinusNumbers:=True
    Cells.Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.ColorIndex = 1
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B2").Select
    With Range("B2")
      .FormulaR1C1 = "=RIGHT(RC[-1],6)"
      .AutoFill Destination:=Range("B2:B" & Range("F65536").End(xlUp).Row)
    End With
    Columns("B:B").Select
    Selection.NumberFormat = "@"
    Range("A1").Select
    Selection.copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight
    Range("E2").Select
    With Range("E2")
      .FormulaR1C1 = "=RIGHT(RC[-1],5)"
      .AutoFill Destination:=Range("E2:E" & Range("F65536").End(xlUp).Row)
    End With
    Columns("E:E").Select
    Selection.NumberFormat = "@"
    Range("D1").Select
    Selection.copy
    Range("E1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("B:B").Select
    Selection.copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("E:E").Select
    Application.CutCopyMode = False
    Selection.copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Columns("J:J").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("K:L").Select
    Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("O:O").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 4), TrailingMinusNumbers:=True
    Columns("R:R").Select
    Selection.Replace What:="'", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Columns("T:T").Select
    Selection.NumberFormat = "#,##0.00"
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.copy
    Columns("V:V").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Cells.Select
    Selection.Columns.AutoFit
    Range("A1").Select
 
 
End Sub

A la fin :arrow: je dispose dans un répertoire de l'ensemble des fichiers au format XLS et qui respecte la mise en forme appliquée ci-dessus.

Le problème :arrow: Je ne sais pas ouvrir et fermer les fichiers à la suite en respectant le format. J'ai bien vu des exemples de codes mais je n'arrive pas à les appliquer sur mon cas, c'est tout de suite trop technique.

Merci d'avance pour votre aide. ;)

Est-ce que ceci te convient ?
Cela ouvre tous les cvs du chemin "C:\Users\...\Desktop\test\".
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub TousLesCSV() ChDir "C:\Users\...\Desktop\test\" monfichier = Dir("*.*") While monfichier <> "" Workbooks.Open monfichier 'ton code MsgBox monfichier Workbooks(monfichier).Close monfichier = Dir() Wend End Sub
Tiens moi au courant ! :ccool:

04/02/2013, 10h12
cyr.odi

Merci Kimy de ton aide :ccool:

Au niveau du résultat, je ne comprends pas très bien pourquoi, mais invariablement, quel que soit le chemin que je mets pour le ChDir, la macro s'applique aux fichiers Excel que j'ai... sur mon bureau!

Pourtant je suis bien avec :

Code:

ChDir "D:\Test\"

Comprends pas...

Sinon, je cherchais à enregistrer au format XLS automatiquement et dans un nouveau répertoire. Exemple :

:arrow: Le fichier de départ est "D:\source\départ.csv"

:arrow: Le résultat automatique est attendu ailleurs et sous un autre format : "D:\traités\départ.xls

Ta proposition me permet de cerner la boucle. Il me manque de fiabiliser le chemin et d'enregistrer automatiquement sous le bon format :ccool:

Code:

1
2
Workbook(monfichier).SaveAs Filename:= "D:\traités\"  & monfichier
Workbook(monfichier).Close True

Code:

1
2
ActiveWorkbook.SaveAs Filename:= "D:\traités\"  & monfichier
ActiveWorkbook.Close True

Tiens moi au courant ! :ccool:

04/02/2013, 17h16
cyr.odi

1 pièce(s) jointe(s)
Merci de ton aide :ccool:

Alors ça ne fonctionne pas au motif qu'il plante au départ.

Comme expliqué ci-dessus, je ne comprends pas. Voici le début de mon code :
Code:

1 2 3 4 5 6 Sub Prog() ChDir ("D:\Test\") monfichier = Dir("*.*") While monfichier <> "" Workbooks.Open monfichier
En l'état, au lieu d'ouvrir les fichiers du répertoire "D:\Test", il ouvre ceux du bureau ("C:\Users\...\Desktop\")

Si je change mon code :
Code:

1 2 3 4 5 6 Sub Prog() ChDir ("D:\Test\") monfichier = Dir("D:\Test\*.*") While monfichier <> "" Workbooks.Open monfichier
Il me retourne une "erreur 1004" en disant qu'il ne trouve pas le premier fichier du répertoire (dont pourtant il me donne le nom (Cf. pièce attachée)

J'avoue ne pas comprendre. Est-ce qu'il ne faudrait pas déclarer une variable et être sûr de la remettre à zéro?
04/02/2013, 18h40
Kimy_Ire

Pardon :

Code:

Workbooks.Open Filename:="D:\Test\" & monfichier

Erreur bête de ma part ! ^^

Bon, je me suis appuyé sur ton code parce que ça ne marchait toujours pas. J'ai écumé un peu le Net et j'ai essayé de répondre un peu par moi-même.

Voilà où j'en suis :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Chemin = "D:\TEST\" FichierDep = Dir("D:\TEST\*.*") While FichierDep <> "" Workbooks.Open Filename:=Chemin & FichierDep Le code ActiveWorkbook.SaveAs Filename:="D:\Résultats\" & FichierDep, FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False ActiveWorkbook.Close True FichierDep = Dir()
J'ai changé "monfichier" en "FichierDep" parce qu'il me reste la galère d’enregistrer le fichier au format XLS. Vu que mon SaveAs ne marche pas, je suppose que c'est parce qu'il y a une contradiction avec le nom de FichierDep qui contient l'extension "csv" mais je n'en suis pas sûr.

Du coup, je pensais faire un "FichierRes" (pour "Résultat") qui aurait le même nom mais avec l'extension "xls". Sauf qu'en fait je ne m'en sors pas et que d'après les discussions que je vois, la commande semble bonne.

Bref il me semble qu'il ne me manque que ça pour valider toute la procédure...

Merci de ton aide :ccool:

Je up un coup pour dire qu'au point où j'en suis, j'ai mes fichiers résultats au bon endroit :
Code:

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 Sub Prog() Application.DisplayAlerts = False Dim FichierDep As String, FirchierRes As String, Chemin As String, sDossier As String, sChaine As String Dim Repertoire As FileDialog MsgBox "Quel est le répertoire des fichiers sources?" Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker) Repertoire.Show sDossier = Repertoire.SelectedItems(1) & "\Resultats" sChaine = Environ("comspec") & " /c mkdir " & sDossier Shell sChaine, 0 Chemin = Repertoire.SelectedItems(1) & "\" FichierDep = Dir(Chemin & "*.*") While FichierDep <> "" Workbooks.Open Filename:=Chemin & FichierDep Le traitement ActiveWorkbook.SaveAs Filename:=sDossier & "/" & FichierDep, FileFormat:=xlNormal, _ Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _ CreateBackup:=False ActiveWorkbook.Close True FichierDep = Dir() Wend Application.DisplayAlerts = True End Sub
J'ai compliqué les choses en laissant l'opérateur choisir le répertoire des fichiers sources et en créant un répertoire des résultats dans celui-ci.

Bon ça fonctionne bien, sauf que les fichiers résultats sont enregistrés avec l'extension ".csv" alors que je voulais ".xls". A priori, c'est pas gênant parce qu'à l'ouverture, c'est comme un fichier XLS.

Ce qui m'ennuie, c'est qu'au moment d'enregistrer le fichier, les utilisateurs vont se voir demander quel format choisir et ça risque de les perdre un peu.

Y a-t-il une solution?

Merci d'avance ;)

06/02/2013, 13h40
Kimy_Ire

essaye ça :

Code:

ActiveWorkbook.SaveAs Filename:=sDossier & "/" & FichierDep & ".xls"

Je n'ai aucune idée si cela fonctionnera ! ^^
06/02/2013, 13h47
Kimy_Ire

Code:

FileFormat:=xlNormal

Je n'avais pas vu ceci. La doc' spécifie :

Citation:

For an existing file, the default format is the last file format specified.

Donc "xlNormal" doit surement sauvegarder le dossier en CSV puisque c'est le dernier format reconnu.
Ici, tu vois tous les formats : http://msdn.microsoft.com/en-us/libr.../ff198017.aspx. Je te propose d'essayer des "FileFormat:=" du style :
- xlExcel2
- xlExcel3
- xlXMLSpreadsheet
- etc...

Tiens moi au courant ! :ccool:
06/02/2013, 14h24
cyr.odi

Merci pour ton aide :ccool:

Ca marche avec ça :

Code:

ActiveWorkbook.SaveAs Filename:=sDossier & "/" & FichierDep & ".xls", FileFormat:=xlWorkbookNormal

Alors si je pouvais abuser, j'aurais 2 améliorations à apporter.

:arrow: Enlever ".csv" du fichier : Là, mes fichiers s'appellent tous "exemple.csv.xls" ce qui n'est pas très jojo. Existe-t-il une commande qui prenne le nom sans extension?

:arrow: Créer un répertoire résultat dans le répertoire des fichiers sources : Mes macros tournent bien sur mon répertoire local mais les fichiers sources sont sur le réseau. Et quand je lance la macro sur des fichiers du réseau, ça plante au niveau de la commande Shell qui, a priori, ne supporte pas des paths avec des espaces dedans. Résultat : elle crée plusieurs répertoires qui sont autant de mots du path qui étaient séparés d'un espace.

Exemple : Sur le réseau, les fichiers sources sont dans "R:\Les fichiers sources sont la". Quand je lance la macro, je me retrouve avec les répertoires "R:\Les", "R:\fichiers", "R:\sources", etc. qui ont été créés.

Du coup, je voudrais juste qu'il crée un répertoire "Resultats" dans le répertoire courant pour y placer les fichiers XLS.

Je peux me lancer mais si tu connais le truc... merci d'avance :ccool:
06/02/2013, 15h01
Kimy_Ire

Enlever le ".cvs" :

Code:

FichierDep = Left(FichierDep, Len(FichierDep) - 4)

Si tu as des espaces, tu peux utiliser la fonction "replace" :

Code:

path = Replace(path, " ", "_")

Pour créer un répertoire, tu as juste a écrire le "nouveau chemin" soit quelque chose du type "R:\Resultats\" et tu sauvegardes tes fichiers en boucle dans ce répertoire.

Tiens moi au courant ! :ccool:
07/02/2013, 11h06
cyr.odi

Ça marche impec pour le nom :ccool:

Bon, pour le path, c'est une autre histoire parce que mon problème est de ne pouvoir accéder au bon répertoire sur le réseau.

J'aurais plus vu le fait de créer un répertoire dans le répertoire courant et d'arriver à y placer les fichiers sans passer par un path entier.

Mais je vais me le regarder tranquillement sur le Net, y a pas d'urgence, c'est assez simplifié comme ça.

Un très grand merci! :ccool: