Convertir plusieurs fichiers excel en csv avec des guillemets

**karido-74** · 24/01/2014, 17h53

bonjour;

j'ai un problème pour automatiser une macro pour convertir plusieurs fichiers excel 2010 en csv avec des guillemets et chaque fichier possède un voir 2 onglets le tout c'est 126 fichiers repartis dans 21 dossier suivants des projets.

la macro :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Export()
    Dim Enrgt As String
    Close #1
    Open "C:\Users\Desktop\test.csv" For Output As #1
    For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
        Enrgt = ""
        For Each x In Range(Cells(c.Row, 1), Cells(c.Row, Columns.Count).End(xlToLeft))
            Enrgt = Enrgt & """;""" & x.Value
        Next x
        Enrgt = Right(Enrgt, Len(Enrgt) - 2) & """"
        Print #1, Enrgt
    Next c
    Close #1
End Sub

En plus de ça j'ai certaines cellules en forme 001 et la macro les converties a 1

merci

**Daniel.C** · 24/01/2014, 19h31

Mets en PJ un échantillon de fichier (sans données confidentielles). Si les fichiers sont répartis dossiers, comment reconnait-on les fichiers à convertir ? ou est-ce l'utilisateur qui choisit ?

**Docmarti** · 25/01/2014, 03h11

Envoyé par karido-74

en plus de ça j'ai certain cellules en forme 001 et la macro les converti a 1
merci

Bonjour

Mets ' devant les valeurs qui débutent par 0 afin de conserver le 0.

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
Sub Export_Valeurs_Debutant_Par_Zero()
Dim Enrgt As String
Close #1
Open "C:\test2\test.csv" For Output As #1
 
For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
Enrgt = ""
 
For Each x In Range(Cells(c.Row, 1), Cells(c.Row, Columns.Count).End(xlToLeft))
 If Enrgt <> "" Then Enrgt = Enrgt & ";"
If Mid(CStr(x.Value), 1, 1) = "0" And IsNumeric(CStr(x.Value) & "0") Then
 Enrgt = Enrgt & Chr(34) & "'" & x.Value & Chr(34)
Else
 Enrgt = Enrgt & Chr(34) & x.Value & Chr(34)
End If
Next x
Print #1, Enrgt
 
Next c
Close #1
End Sub

Cordialement

Docmarti

**karido-74** · 27/01/2014, 15h05

Bonjour,

j'ai réussi a trouver une autre macro sur le net qui ne convertie pas les cellules (001 en 1) sauf que cette macro elle ne met pas les champs entre guillemets

voila la macro

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
 
Sub Placeoweb_XLS2CSV_OneFileBySheet()
 
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
   For Each feuilleEnCours In ThisWorkbook.Sheets
       feuilleEnCours.Select
       feuilleEnCours.Copy
       ActiveWorkbook.SaveAs Filename:="C:\placeoweb.com.xls2csv." & feuilleEnCours.Name & ".csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True
       ActiveWorkbook.Close SaveChanges:=False
   Next
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
 
   MsgBox ("Exportation terminée, retouvez vos fichier à la racine dans le C:\")
 
End Sub

merci

**Daniel.C** · 27/01/2014, 15h18

Bonjour,

Je répète :

Si les fichiers sont répartis dossiers, comment reconnait-on les fichiers à convertir ? ou est-ce l'utilisateur qui choisit ?

**karido-74** · 27/01/2014, 15h31

En fait tout les dossiers contiennent plusieurs fichiers xlsx donc pour la conversion c'est tous les fichiers (L'utilisateur ne choisit pas)

La nouvelle macro m’arrange bien sauf qu'il lui manque juste l'ajout des guillemets

**Daniel.C** · 27/01/2014, 17h56

la nouvelles macro que elle m’arrange bien sauf que il lui manque juste pour rajouter les guillemets

Oui mais il n'y a pas moyen de l'adapter.

**karido-74** · 27/01/2014, 20h07

Merci mais existe-t-il un autre moyen avec une autre macro juste pour avoir les guillemets et qu'elle garde le même format de cellule ?

**Daniel.C** · 27/01/2014, 20h11

Je ne peux pas traiter tous les dossiers de ton disque. La macro suivante te permets de choisir 1 dossier et traite tous les fichiers .xlsx. Chaqque fefuille contenant des données est sauvegardée dans le dossier sous le nom nom du classeur - nom de la feuille.csv.

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
Sub ExportDossierCSV()
    Dim Enrgt As String, FSO As Object, F As Object, Dossier As String
    Dim Repertoire As FileDialog, Sh As Worksheet, Wbk As Workbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    For Each F In FSO.getfolder(Repertoire.SelectedItems(1)).Files
        Dossier = Repertoire.SelectedItems(1)
        If LCase(Right(F.Name, 5)) = ".xlsx" Then
            Set Wbk = Workbooks.Open(F.Path)
 
            For i = 1 To Wbk.Worksheets.Count
                Set Sh = Wbk.Worksheets(i)
                If Application.CountA(Sh.Cells) > 0 Then
 
                    Close #1
                    Open Dossier & "\" & Left(Wbk.Name, Len(Wbk.Name) - 5) & "-" & Sh.Name & ".csv" For Output As #1
                    For Each c In Range([A1], Cells(Rows.Count, 1).End(xlUp))
                        Enrgt = ""
                        For Each x In Range(Cells(c.Row, 1), Cells(c.Row, Columns.Count).End(xlToLeft))
                            Enrgt = Enrgt & """;""" & x.Value
                        Next x
                        Enrgt = Right(Enrgt, Len(Enrgt) - 2) & """"
                        Print #1, Enrgt
                    Next c
                    Close #1
                End If
            Next i
            Wbk.Close , False
 
        End If
    Next F
End Sub

**karido-74** · 27/01/2014, 20h25

Comment je vais exécuter cette macro ?
(Désolé pour cette question)

[Edit] Est-ce que j'ouvre un fichier faisant l'objet de conversion vers csv dans un dossier particulier ou je crée un nouveau fichier excel et je dois parcourir le dossier ou il y a mes fichiers excel

Cordialement

**Daniel.C** · 27/01/2014, 20h53

Onglet Affichage, bouton Macros, clique sur le nom de la macro et sur "Exécuter".

Il faut auparavant coller cette macro dans un classeur :

1. appuie sur Alt+F11. La fenêtre VBE s'ouvre
2. Repère dans la partie gauche le projet qui porte le nom de ton classeur. Clique dessus.
3. clique sur "Insertion" et "Module". Dans la partie droite, colle la macro.

N'ouvre aucun autre classeur. Exécute seulement la macro.

**karido-74** · 27/01/2014, 21h02

Moi d'habitude j'ouvre mon fichier Excel et tape Alt F11.

Puis j'insère un nouveau module, je colle le code et F5 pour exécuter.

Ensuite je parcours le dossier ou il y a mes fichiers Excel.
il y a un problème avec:

Set Wbk = Workbooks.Open(F.Path)

Cordialement

**Daniel.C** · 27/01/2014, 21h57

moi d'habitude j'ouvre mon fichier excel te tape Alt F11
puis insère un new module je colle le code

Je n'ai pas écrit autre chose.

comment je vais exécuter cette macro désoler pour cette question

Si tu le sais, pourquoi poses-tu la question ?

et F5 pour exécuter

Tu peux aussi faire comme ça.

ensuite je parcoure le dossier ou il ya mes fichier excel

Pas compris ?

il ya un problème avec:

Set Wbk = Workbooks.Open(F.Path)

QUEL problème ?

**karido-74** · 27/01/2014, 22h06

Désolé, quand j’exécute la macro il y a une fenêtre qui s'ouvre je cherche alors le dossier ou il y a mes fichier Excel.

Ensuite je clic ok il y a une fenêtre qui s'ouvre de la macro pour debuger et quand je clic il y a la phrase dans le message précédent.

j'ai mis en pièce jointe l'impression écran

Cordialement

**Daniel.C** · 28/01/2014, 13h50

Bonjour,

Exécute cette macro, note le contenu des deux msgboxes et poste-les.

**karido-74** · 28/01/2014, 21h34

Bonsoir Daniel,

Désolé de vous répondre en retard, j'ai exécuté la macro et vous trouverez toutes les étapes dans les pièces jointes qui sont numérotées de image1 a image5.

Cordialement

**Daniel.C** · 28/01/2014, 21h44

Ce n'est pas ce que je t'ai demandé. Ce n'est même pas la dernière macro envoyée.

**karido-74** · 28/01/2014, 22h03

Bonsoir Daniel,

Je n'ai pas reçu la dernière macro

Cordialement

**Docmarti** · 29/01/2014, 00h48

Bonsoir Daniel; karido

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
Sub Daniel_ExportDossierCSV()
 
    Dim Enrgt As String, FSO As Object, F As Object, Dossier As String
    Dim Repertoire As FileDialog, Sh As Worksheet, Wbk As Workbook
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
    Repertoire.Show
    For Each F In FSO.getfolder(Repertoire.SelectedItems(1)).Files
        Dossier = Repertoire.SelectedItems(1)
 
        If LCase(Right(F.Name, 4)) = ".xls" Then
            Set Wbk = Workbooks.Open(F.Path)
 
            For i = 1 To Wbk.Worksheets.Count
                Set Sh = Wbk.Worksheets(i)
                Debug.Print Dossier & "\" & F.Name & "-" & Sh.Name & ".csv"
 
                If Application.CountA(Sh.Cells) > 0 Then
 
                    Close #1
                    Open Dossier & "\" & F.Name & "-" & Sh.Name & ".csv" For Output As #1
                    For Each c In Sh.Range(Sh.Cells(1, 1), Sh.Cells(Rows.Count, 1).End(xlUp))
                        Enrgt = ""
                        For Each x In Sh.Range(Sh.Cells(c.Row, 1), Sh.Cells(c.Row, Columns.Count).End(xlToLeft))
                            Enrgt = Enrgt & """;""" & x.Value
                        Next x
                        Enrgt = Right(Enrgt, Len(Enrgt) - 2) & """"
                        Print #1, Enrgt
                    Next c
                    Close #1
                End If
            Next i
            Wbk.Close , False
 
        End If
    Next F
 
End Sub