Conserver les zéros devant un nombre lors de l'export d'une feuille Excel en csv

Version imprimable

Bonjour,

Je débute en VBA et je dois exporter une feuille Excel "Dossier_EUR" du fichier "ARCHIDOSS" dans un fichier CSV (qui sera importé dans une application).
Dans la colonne A de cette feuille Excel figurent des nombres sur 11 caractères dont certains commencent par "0" ou "00",..., cette colonne est bien au format texte. Or lorsque je crée mon fichier CSV ces 0 ne sont pas conservés.

La macro que j'utilise est la suivante :

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 Export_Dossier()
 
 
 
Dim fso As New FileSystemObject
Dim MonFichier As TextStream
 
 
    DateA = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 5).Value
    DateM = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 4).Value
    Ref = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 3).Value
 
Set MonFichier = fso.CreateTextFile("R:\Dossier _" & DateA & "_" & DateM & "_" & Ref & ".csv")
 
i = 16
While Sheets("Dossier_EUR").Cells(i, 2).Value <> ""
    MonFichier.WriteLine Sheets("Dossier_EUR").Cells(i, 2).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 3).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 4).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 5).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 6).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 7).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 8).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 9).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 10).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 11).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 12).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 13).Value
    i = i + 1
Wend
 
 
MonFichier.Close
 
End Sub

J'ai essayé de rajouter ce bout de macro après le "Wend":

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim xCell As Range
Dim Plage As Range
Dim x As String
Dim y As Byte
Dim z As String
 
Set Plage = Range("A2:A" & Cells(Rows.Count, "a").End(xlUp).Row)
Plage.NumberFormat = "@"
 
For Each xCell In Plage
 
    If Len(xCell.Value) < 11 Then
        x = xCell.Value
        y = 11 - Len(xCell.Value)
        z = Application.WorksheetFunction.Rept("0", y)
        xCell.Value = z & x
    End If
 
Next xCell

Mais cela ne fonctionne pas.

Pourriez-vous m'aider s'il vous plait ?

Merci.

13/05/2022, 10h07
BENNASR

bonjour
essayer avec le format personnalisé "0000" si tu doit avoir 4 chiffre
15/05/2022, 16h48
laurent_ott

Bonjour,
J'utilise une mise au format des cellules, puis dans un deuxième temps cells.Text et non pas cells.Value pour enregistrer en CSV le contenu (visible à l'écran) de la cellule et non pas sa valeur.
Attention, la largeur de la cellule ne doit pas être tronquée sans quoi il est enregistré des ##, comme la représentation à l'écran.

Bonne programmation.

Je vous remercie pour votre aide.

J'ai essayé de faire une mise au format des cellules du fichier Excel d'origine en ajoutant :

Sheets("Dossier_EUR").Column("A:A").FormatNumber = "@" dans la macro
Puis en mettant.Text au lieu de .Value au niveau de l'écriture de la première colonne dans le fichier CSV

soit :

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
Sub Export_Dossier()
 
 
 
Dim fso As New FileSystemObject
Dim MonFichier As TextStream
 
 
    DateA = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 5).Value
    DateM = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 4).Value
    Ref = Workbooks("ARCHIDOS.xlsm").Sheets("MENU").Cells(8, 3).Value
 
 
Sheets("Dossier_EUR").Column("A:A").FormatNumber = "@"
 
Set MonFichier = fso.CreateTextFile("R:\Dossier _" & DateA & "_" & DateM & "_" & Ref & ".csv")
 
i = 16
While Sheets("Dossier_EUR").Cells(i, 2).Value <> ""
    MonFichier.WriteLine Sheets("Dossier_EUR").Cells(i, 2).Text & _
    (";") & Sheets("Dossier_EUR").Cells(i, 3).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 4).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 5).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 6).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 7).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 8).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 9).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 10).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 11).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 12).Value & _
    (";") & Sheets("Dossier_EUR").Cells(i, 13).Value
    i = i + 1
Wend
 
 
MonFichier.Close

Mais cela ne fonctionne pas.

Petite précision : le format de la première colonne est sur 11 caractères.

Je vous remercie pour votre aide.

End Sub

16/05/2022, 14h21
BENNASR

re
essaye avec :

Code:

Sheets("Dossier_EUR").Column("A:A").NumberFormat = "00000000000"

attention :

.NumberFormat
et non pas

.FormatNumber