Convertir plusieurs fichiers excel en csv avec des guillemets

Version imprimable

Voir 40 message(s) de cette discussion en une page

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:

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

24/01/2014, 19h31
Daniel.C

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 ?

Citation:

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:

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

1 pièce(s) jointe(s)

nouvelles macro

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:

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

27/01/2014, 15h18
Daniel.C

Bonjour,

Je répète :

Citation:

Si les fichiers sont répartis dossiers, comment reconnait-on les fichiers à convertir ? ou est-ce l'utilisateur qui choisit ?
27/01/2014, 15h31
karido-74

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
27/01/2014, 17h56
Daniel.C

Citation:

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.
27/01/2014, 20h07
karido-74

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 ?

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:

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

27/01/2014, 20h25
karido-74

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
27/01/2014, 20h53
Daniel.C

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.
27/01/2014, 21h02
karido-74

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
27/01/2014, 21h57
Daniel.C

Citation:

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.

Citation:

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

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

Citation:

et F5 pour exécuter

Tu peux aussi faire comme ça.

Citation:

ensuite je parcoure le dossier ou il ya mes fichier excel

Pas compris ?

Citation:

il ya un problème avec:

Set Wbk = Workbooks.Open(F.Path)

QUEL problème ?
27/01/2014, 22h06
karido-74

1 pièce(s) jointe(s)

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
28/01/2014, 13h50
Daniel.C

Bonjour,

Exécute cette macro, note le contenu des deux msgboxes et poste-les.
28/01/2014, 21h34
karido-74

1 pièce(s) jointe(s)

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
28/01/2014, 21h44
Daniel.C

Ce n'est pas ce que je t'ai demandé. Ce n'est même pas la dernière macro envoyée.
28/01/2014, 22h03
karido-74

Bonsoir Daniel,

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

Cordialement

Bonsoir Daniel; karido

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
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

29/01/2014, 10h06
Daniel.C

Bonjour,

Essaie plutôt le code de Docmarti qui a l'avantage de te permettre plusieurs dossiers.

Voir 40 message(s) de cette discussion en une page