Traitement CSV et enregistrement en XLS

**cyr.odi** · 01/02/2013, 17h17

Bonjour,

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

Le départ

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

Mon traitement de mise en forme est le suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

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.

**Kimy_Ire** · 01/02/2013, 18h42

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

**cyr.odi** · 04/02/2013, 11h12

Merci Kimy de ton aide

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

ChDir "D:\Test\"

Comprends pas...

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

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

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

**Kimy_Ire** · 04/02/2013, 15h46

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

ou

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Tiens moi au courant !

**cyr.odi** · 04/02/2013, 18h16

Merci de ton aide

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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?

**Kimy_Ire** · 04/02/2013, 19h40

Pardon :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Erreur bête de ma part ! ^^

**cyr.odi** · 05/02/2013, 11h37

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**cyr.odi** · 06/02/2013, 11h45

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Kimy_Ire** · 06/02/2013, 14h40

essaye ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Je n'ai aucune idée si cela fonctionnera ! ^^

**Kimy_Ire** · 06/02/2013, 14h47

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

FileFormat:=xlNormal

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

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 !

**cyr.odi** · 06/02/2013, 15h24

Merci pour ton aide

Ca marche avec ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

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?

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

**Kimy_Ire** · 06/02/2013, 16h01

Enlever le ".cvs" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 !

**cyr.odi** · 07/02/2013, 12h06

Ça marche impec pour le nom

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!

Traitement CSV et enregistrement en XLS [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager