Ecrire string sans les guillemets

Bonjour,

Je suis en train de chercher à exporter un tableau excel en .csv, or le simple enregistrement au format ne suffit pas pour utiliser les données dans le programme après.

Je dois donc actuellement rentrer manuellement les valeurs séparées par des , puis sauvegarder pour pouvoir l'utiliser après.

j'ai voulu l'automatiser, en faisant une petite macro que voici:
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 Sub convertion() Application.ScreenUpdating = False Dim ligne As String Feuil1.Activate Dim NbLigne As Integer, NbCol As Integer, i As Integer, j As Integer NbLigne = Range("A" & Rows.Count).End(xlUp).Row NbCol = Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To NbLigne ligne = CStr(Cells(i, 1)) For j = 2 To NbCol ligne = ligne + "," + CStr(Cells(i, j)) Next Feuil2.Activate Cells(i, 1) = ligne Feuil1.Activate Next Feuil2.Activate Dim chemin As Variant Application.ScreenUpdating = True chemin = Application.GetSaveAsFilename( _ fileFilter:="Excel Files (*.csv), *.csv") If chemin <> False Then ActiveWorkbook.SaveAs Filename:= _ chemin, FileFormat:=xlCSV _ , CreateBackup:=False End If End Sub
Cependant, comme il écrit un string dans la case il inclut aussi les guillemets "". J'ai vu en cherchant que l'on pouvait éviter cela en utilisant print # cependant comment l'utiliser pour une variable??

à noter que si je ré ouvre le fichier issu de cette macro et que je ré enregistre cela fonctionne parfaitement.

(si j'ouvre le fichier avec le bloc notes, j'obtiendrais dans le premier cas: "1,2,3,4", puis après réenregistrement 1,2,3,4)

il est clair que le logiciel utilisant le ficher ne supporte donc pas les guillemets cependant je ne trouve pas comment les supprimer, j'ai essayé de voir en utilisant la fonction mid, mais cela ne coupe pas les guillemets.

Si vous avez une idée merci de le faire savoir.

Comme déjà indiqué dans la première discussion, en dehors de la FAQ et des tutoriels,
voir dans les discussions de ce forum comme par exemple celle-ci …

1 pièce(s) jointe(s)

Bonjour,
regarde le fichier joint!

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub convertion()
Application.ScreenUpdating = False
Dim R  As Range
Dim Txt As String
Dim WinXp As New clsWindowsExporer
WinXp.Creer_Repertoires Environ("Userprofile") & "\toto"
WinXp.Supprimer_Fichier Environ("Userprofile") & "\toto\toto.csv"
Set R = Sheets("Feuil1").UsedRange
For I = 1 To R.Rows.Count
   Txt = ""
    For j = 1 To R.Columns.Count
        If Txt = "" Then
            Txt = CStr(R(I, j))
        Else
            Txt = Txt + "," + CStr(R(I, j))
        End If
    Next
   WinXp.FichierLog Environ("Userprofile") & "\toto\toto.csv", Txt & vbCrLf
Next
Set WinXp = Nothing
End Sub

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
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = fso.FolderExists(Repertoires)
Set fso = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim fso As Object
Dim Rep As Object
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
  Dim fso As Object
Dim Rep As Object
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Repertoire_Date_Creation = Rep.DateCreated
 
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim t
Dim R As String
Dim I As Long
R = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t)
    If Trim("" & t(I)) <> "" Then
        R = R & Trim("" & t(I)) & "\"
        If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
    End If
Next
Set fso = Nothing
End Sub
 
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Function Deplace_Repertoire(Source As String, Destination As String) As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set fso = Nothing
End Function
 
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Taille d'un répertoire
Public Function Taille_Fichier(Fichier)
Dim fso As Object
Dim Fich As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = fso.FileExists(Fichier)
Set fso = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_Name(Fichier As String)
Dim fso As Object
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = fso.GetBaseName(Fichier)
Set fso = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_extension(Fichier As String)
Dim fso As Object
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = fso.GetExtensionName(Fichier)
Set fso = Nothing
End If
End Function
 
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Source, Destination, True
Set fso = Nothing
End Sub
 
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source As String, Destination As String)
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source, Destination
Set fso = Nothing
End Sub
 
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier As String)
If Fichier_Exist(DelFichier) = True Then
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim fso, NewFichier
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(sFile, 8)
 
NewFichier.Write sText
NewFichier.Close
 
Set NewFichier = Nothing
Set fso = Nothing
 
End Function
 
Public Sub FichierLog(sFile, Txt)
Dim FichierLog, fso
 
FichierLog = sFile
 
 
''CreerPath FichierLog
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
 
AppendTxt FichierLog, Txt
 
Set fso = Nothing
End Sub
 
Private Sub EnteteFichier(Fichier)
Dim Txt, fso, NewFichier
 
Txt = "***********************************************************************************************************************************************************************************"
Txt = Txt & vbCrLf
Txt = Txt & ""
Txt = Txt & vbCrLf
Txt = Txt & "   Date de création: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
Txt = Txt & vbCrLf
Txt = Txt & "   " & Fichier
Txt = Txt & vbCrLf
Txt = Txt & "***********************************************************************************************************************************************************************************"
Txt = Txt & vbCrLf
Txt = Txt & vbCrLf
Txt = ""
 'WScript.Echo Fichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write Txt
NewFichier.Close
 
 
Set NewFichier = Nothing
Set fso = Nothing
End Sub