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):
A quel endroit dans ce code ci-dessous je dois ajouter un truc du type .NumberFormat = "@" ?
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
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
Partager