Discussion :

[wilfryjules]

Bonjour à tous,

J'ai une table dans une IHM que je souhaite exporter au format CSV.
(Après certaines traductions à partir de tableau de changement yes <=> 1, no<=> 0 etc...)
Jusque là je l'exportais en format txt avec un ; comme séparateur, mais on me demande de l'exporter directement en .csv
Seulement voilà, je dois ajouter le format aux colonnes car j'ai des données de type fraction (ex: 12/1) et je ne veux pas qu'elles apparaissent comme une date (ici 12 janvier) lors de l'import (réouverture du fichier excel exporté en csv).

Ne vous focalisez pas sur tout le code car il y a des choses hors contexte pour vous, mais dites moi uniquement comment, après la création d'un fichier Freefile de type csv, je peux forcer le format des colonnes (texte, date...)

Voici le tableau que je souhaite exporter en CSV:



Voici le soucis que j'ai lors de la réouverture du fichier csv (les fractions se transforment en date):

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
 
 
Private Sub Btn_Export_Click()
    Dim Directory As String
    Dim R As Range
 
    Dim FullPath As String
    Dim CSV_Path As String
    Dim Engine_Num As String
    Dim Engine_Num_Date As String
 
    If Not checkEmptyCell Then
        MsgBox "Please complete all table."
        Exit Sub
    End If
 
    FullPath = Application.GetSaveAsFilename( _
     InitialFileName:=Range("Engine_Num").VALUE, _
     TITLE:="Select the directory and name of your .csv file", _
     fileFilter:=".csv files (*.csv), *.csv")
 
     CSV_Path = GetDirectory(FullPath)
     Engine_Num = GetFileName(FullPath, True)
 
 
     ' On interdit les caractères spéciaux (supression automatique sans avertissement)
     Engine_Num = EngineNumFilter(Engine_Num)
 
     Engine_Num_Date = Engine_Num & "_" & Replace(Date, "/", "_")
 
    Range("CSV_Path").VALUE = CSV_Path
    Engine_Num = EngineNumFilter(Engine_Num)
    Range("Engine_Num").VALUE = Engine_Num
    FullPath = CSV_Path & "/" & Engine_Num_Date & ".csv"
 
    ExportCSV FullPath
 
End Sub

A quel endroit dans ce code ci-dessous je dois ajouter un truc du type .NumberFormat = "@" ?

Merci.

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
 
 
' Creation du fichier .csv
Private Sub ExportCSV(Path As String)
 
    Dim fic As Integer, i As Integer, j As Integer
    Dim Line As String
    Dim VALUE As Variant
    Dim shCONFIG As Object
    Set shCONFIG = Sheets("CONFIG")
    Dim Tab_CSV As ListObject
    Set Tab_CSV = ListObjects("Tab_CSV")
    Dim ncols As Integer, nrows As Integer
    ncols = Tab_CSV.ListColumns.Count
    nrows = Tab_CSV.ListRows.Count
    Dim Rcsv As Range, Rcsv0 As Range, Rdata As Range, Rheader As Range, Rval As Range
    Set Rcsv = Range(Tab_CSV)
    Set Rcsv0 = Tab_CSV.Range ' attention, ici la 1ere ligne est celle des titres
 
    Set Rdata = Tab_CSV.DataBodyRange
    Set Rheader = Tab_CSV.HeaderRowRange
    Dim excel As excel.Application
    Dim xlBook As excel.Workbook
    Dim xlSheet As excel.Sheets
 
    If FileExists(Path) Then
       ' Set xlBook = GetObject(Path)
        'xlBook.Close
        'Set xlBook = Nothing
        Kill Path
    End If
 
    fic = FreeFile
 
    Open Path For Output As #fic
 
    With Rcsv0
        For i = 1 To nrows + 1 ' Modif A.TROCHU Ajout +1 car prise en compte de la ligne de titre1/0
            For j = 1 To ncols
                VALUE = .Cells(i, j).Text
                If i > 1 Then
                    Select Case j
                        Case 1:
                            ' TST_ACTIV_OP
                            Set Rval = shCONFIG.Range("Tab_TST_ACTIV_OP")
                            VALUE = WorksheetFunction.VLookup(VALUE, Rval, 2, False)
                        Case 2:
                            ' TST_CMOD
                            Set Rval = shCONFIG.Range("Tab_TST_CMOD")
                            VALUE = WorksheetFunction.VLookup(VALUE, Rval, 2, False)
                    End Select
                End If
 
                If j > 1 Then
                    Line = Line & ";" & VALUE
                Else
                    Line = VALUE
                End If
            Next j
            Print #fic, Line
        Next i
    End With
 
    Close #fic
 
' MAINTENANT QUE J'AI ECRIT TOUT MON FICHIER, COMMENT RENTRER LE FORMAT DES COLONNES ???
End Sub