Export d'un tableau en .CSV avec séparateur forcé (différent de "," ou ";")

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

je vous explique ma problématique, j'ai un tableau tout bête (3 colonnes, 5 lignes) sous excel que j'aimerais exporter en .CSV.
Le problème dans ma macro, est au niveau du séparateur à l'export je voudrais le forcer à être un "pipe" >>> "|" (touches alt + 6) et non un séparateur pré-définit par les paramètres région et langue de windows (voir image).

Ci-dessous le bout de code pour faire mon export en CSV
Code:

1 2 3 4 ActiveWorkbook.SaveAs , FileFormat:=xlCSV, Local:=False 'ici le séparateur est une virgule , 'ou ActiveWorkbook.SaveAs , FileFormat:=xlCSV, Local:=True 'ici le séparateur est un point-virgule ;
Quelqu'un aurait-il une idée pour avoir un "|" à la place de ces deux caractères, sans toucher aux paramètres régionaux bien sur :) ?

Je vous remercie par avance,
Gaëtan

Essayes ce code

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
 
Sub Ecrire_CSV()
Dim Rng As Range, Ligne As Range, Cel As Range
Dim sStr As String, sNomFichier As String
Dim NumFichier As Integer
Dim sSep As String
 
    sSep = "|"
    sNomFichier = ThisWorkbook.Path & "\nomfich" 
    Set Rng = ActiveSheet.UsedRange
 
    Close
    NumFichier = FreeFile
 
    Open sNomFichier For Output As #NumFichier
        For Each Ligne In Rng.Rows
            sStr = ""
            For Each Cel In Ligne.Cells
                sStr = sStr & Cel.Text & sSep
            Next Cel
            Print #NumFichier, sStr
        Next Ligne
    Close #NumFichier
End Sub

30/08/2016, 14h17
Menhir

Autant pour l'import, il y a pas mal de possibilités, autant pour l'export, il est difficile de sortir des formats prédéfinis.

La seule méthode que je vois est d'enregistrer les données une par une en séquentiel.
https://msdn.microsoft.com/fr-fr/lib.../gg264163.aspx
https://msdn.microsoft.com/fr-fr/lib.../gg264524.aspx

Pour un petit tableau comme le tien, ça devrait pouvoir se faire en une dizaine de lignes de code.

Bonjour,

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
#If VBA7 Then
 Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As LongPtr, ByVal dwBytes As LongPtr) As Long
 Private Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
 Private Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
 Private Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
 Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 Private Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As LongPtr, ByVal hMem As LongPtr) As Long
 Private Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#Else
 Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
 Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
 Private Declare Function CloseClipboard Lib "User32" () As Long
 Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
 Private Declare Function EmptyClipboard Lib "User32" () As Long
 Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
 Private Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
#End If
Private Const GHND = &H42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
 
Sub test()
Dim txt As String, Fichier As String
Fichier = Split(ThisWorkbook.FullName, ".xls")(0) & ".CSV"
ActiveSheet.UsedRange.Copy
txt = ClipBoard_GetData
txt = Replace(txt, vbTab, "|")
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Fichier) = True Then fso.DeleteFile Fichier, True
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
 
End Sub
Function ClipBoard_GetData() As String
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
 
   If OpenClipboard(0&) = 0 Then
      MsgBox "Cannot open Clipboard. Another app. may have it open"
      Exit Function
   End If
 
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "Could not allocate memory"
      GoTo OutOfHere
   End If
 
   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)
 
   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
 
      ' Peel off the null terminating character.
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "Could not lock memory to copy string from."
   End If
 
OutOfHere:
 
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString
 
End Function
Function ClipBoard_SetData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long
 
   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
 
   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)
 
   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
 
   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If
 
   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If
 
   ' Clear the Clipboard.
   X = EmptyClipboard()
 
   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
 
OutOfHere2:
 
   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If
 
   End Function

Salut, bestialement qqch dans le genre

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
Option Explicit
 
Sub EcritureFichier()
Dim Rng As Range, Ligne As Range, Cel As Range
Dim sStr As String, sNomFichier As String
Dim NumFichier As Integer
Dim sSep As String
 
    sSep = "|"
    sNomFichier = ThisWorkbook.Path & "\" & "Essai.txt"
    Set Rng = Feuil1.UsedRange
 
    Close
    NumFichier = FreeFile
 
    Open sNomFichier For Output As #NumFichier
    For Each Ligne In Rng.Rows
        sStr = ""
        For Each Cel In Ligne.Cells
            sStr = sStr & Cel.Text & sSep
        Next Cel
        Print #NumFichier, sStr
    Next Ligne
    Close #NumFichier
End Sub

30/08/2016, 14h31
gaett

Merci beaucoup à vous pour vos réponses rapides et efficaces,

ça fonctionne avec le code de hs.hs !

:)