Bonjour à tous,

Je vous expose mon petit problème :

J'utilise une macro ci-dessous qui m'enregistre un tableau Excel en un fichier CSV (utf8).
La macro n'est pas de moi et j'ignore son origine. Je m'en excuse d'avance auprès de son créateur.
Je ne l'ai que très légèrement modifiée et la macro fonctionne. Elle est globalement ce que je recherche.

Toutefois la macro n'exporte pas toutes mes valeurs. Par exemple quand ma plage de valeurs contient une colonne vide elle s'arrête à la colonne vide et ne traite pas le reste situé sur les colonnes suivantes.
Ma question est : savez-vous comment modifier la macro afin qu'elle enregistre tout, colonnes vides incluses ?

Merci d'avance pour l'aide que je peux obtenir.
Crdt,
G

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
 
 
Public Sub WriteCSV()
Set wkb = ActiveSheet
Dim fileName As String
Dim MyPath As String
Dim MaxCols As Integer
MyPath = "H:\"
 
fileName = "18068-02_" & Format(Date, "yyyymmdd") & Format(Time, "hhmm") & ".csv"
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
'Copies the sheet to a new workbook:
Sheets("test").Copy
 
If fileName = "False" Then
End
End If
 
On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
 
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Charset = "UTF-8"
BinaryStream.Type = adTypeText
BinaryStream.Open
 
For r = 1 To 20
s = ""
c = 1
While Not IsEmpty(wkb.Cells(r, c).Value)
s = s & wkb.Cells(r, c).Value & ","
c = c + 1
Wend
BinaryStream.WriteText s, 1
Next r
 
BinaryStream.SaveToFile MyPath & fileName, adSaveCreateOverWrite
BinaryStream.Close
 
ActiveWorkbook.Close Savechanges:=False
 
MsgBox "CSV généré sous H:\"
 
eh:
 
End Sub