Discussion :

[Gabriel_]

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

[Invité]

Bonjour,

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
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}" 
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").UsedRange.Copy
 
If fileName = "False" Then
End
End If
 
'On Error GoTo eh
Const adTypeText = 2
Const adSaveCreateOverWrite = 2
 
With CreateObject("ADODB.Stream")
    .Charset = "UTF-8"
    .Type = adTypeText
    .Open
    .WriteText Replace(PressePapier, vbTab, ",")
    .SaveToFile MyPath & fileName, adSaveCreateOverWrite
    .Close
 
ActiveWorkbook.Close Savechanges:=False
 End With
MsgBox "CSV généré sous H:\"
 
eh:
 
End Sub
Public Property Let PressePapier(Value)
    With CreateObject(DATAOBJECT_BINDING)
        .SetText Value
        .PutInClipboard
    End With
End Property
 
Public Property Get PressePapier()
    With CreateObject(DATAOBJECT_BINDING)
        .GetFromClipboard
        PressePapier = .GetText
    End With
End Property

[Gabriel_]

Merci pour le code mais il m'indique une erreur à la ligne
"With CreateObject(DATAOBJECT_BINDING)"

et il dit :
Un composant activex ne peut pas créer d'objet...
Une histoire de références VBA !?

[Invité]

Tu as créé la.constate

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"

[Gabriel_]

En effet je l'ai oublié dans la copie. Pfff.
A présent ça fonctionne en effet exactement comme souhaité.
Merci beaucoup encore.