Sauvegarde CSV

[chocapic]

Bonjour à tous, je post mon premier message, mais je vous suis depuis longtemps et j'avais jusqu’à présent toujours trouvé toute les solutions grâce à vos différent post et je vous en remercie.

Mon problème aujourd'hui est quand je fais une sauvegarde en CSV via la macro ci dessous, ça fonctionne mais je souhaiterai qu'il ne mette pas de séparateur tout à la fin.
actuellement:

firstname|lastname|language|enableclient|
Sebastien|toto|fr_FR|1|

ce que j'aimerai

firstname|lastname|language|enableclient
Sebastien|toto|fr_FR|1

Sub SaveAsCSVRep(FileName$)
Dim Range As Object, Line As Object, cell As Object
Dim StrTemp As String
Dim Separateur As String
Separateur = "|"
Set Range = ActiveSheet.UsedRange.End(xlUp).Row
Open FileName For Output As #1
For Each Line In Range.Rows
StrTemp = ""
For Each cell In Line.Cells
StrTemp = StrTemp & CStr _
(cell.Text) & Separateur
Next
Print #1, StrTemp
Next
Close
End Sub

 

[MJ13]

Re : Sauvegarde CSV

Bonjour Chocapic

Tu peux tester cette macro.

Sub SaveAsCSVRep() '(FileName$)
Dim Range As Object, Line As Object, cell As Object
FileName = "C:\temp\text.csv"
Dim StrTemp As String
Dim Separateur As String
Separateur = "|"
Set Range = Selection 'ActiveSheet.UsedRange.End(xlUp).Row
Open FileName For Output As #1
For Each Line In Range.Rows
StrTemp = ""
For Each cell In Line.Cells
StrTemp = StrTemp & CStr _
(cell.Text) & Separateur
Next
StrTemp2 = Mid(StrTemp, 1, Len(StrTemp) - 1)
Print #1, StrTemp2
Next
Close
End Sub

Merci, je vais le mettre dans mon Pense-bête, cela pourrait m'être utile.

 

[chocapic]

Re : Sauvegarde CSV

Merci pour ta reponse rapide, malheureusement ça ne m'a rien changé... 🙁
j'ai vu que tu as egalement ajouté une ligne FileName
mon fichier n'en a pas car je l'ajoute sur la sub juste avant

Sub Save_CSV_Rep()
Dim fich$
Dim cell As Range
Dim nom_client As String

nom_client = Worksheets("Résumé").Range("C7")

If Len(Dir("C:\\XIVO", vbDirectory)) = 0 Then
MkDir "C:\\XIVO"
End If

If Len(Dir("C:\\XIVO\" & nom_client, vbDirectory)) = 0 Then
MkDir "C:\\XIVO\" & nom_client
End If

fich = "C:\\XIVO\" & nom_client & "\imp_rep.csv"

SaveAsCSVRep fich
'OpenCSV fich


End Sub

 

[chocapic]

Re : Sauvegarde CSV

Je me permet de faire un UP, problème assez important vu qu'il concerne l'import de grosse BD

 

[MJ13]

Re : Sauvegarde CSV

Re

Merci pour ta reponse rapide, malheureusement ça ne m'a rien changé... 🙁
j'ai vu que tu as egalement ajouté une ligne FileName
mon fichier n'en a pas car je l'ajoute sur la sub juste avant

J'ai juste voulu tester rapidement mais normalement en modifiant ces 2 lignes dans ton code original, cela dervrait le faire:

StrTemp2 = Mid(StrTemp, 1, Len(StrTemp) - 1)
Print #1, StrTemp2

Tiens nous au courant 🙂.

 

[kiki29]

Re : Sauvegarde CSV

Salut, à tester

Option Explicit

Sub SaveAsCSVRep()
Dim Rng As Range, Lne As Range, cel As Range
Dim StrTemp As String
Dim Separateur As String
Dim FileName As String
Dim LastCol As Long

    FileName = ThisWorkbook.Path & "\" & "Test.csv"
    Separateur = "|"
    Set Rng = ActiveSheet.UsedRange

    Open FileName For Output As #1
    For Each Lne In Rng.Rows
        StrTemp = ""
        For Each cel In Lne.Cells
            LastCol = Lne.Cells.End(xlToRight).Column
            If cel.Column >= LastCol Then
                StrTemp = StrTemp & CStr(cel.Text)
            Else
                StrTemp = StrTemp & CStr(cel.Text) & Separateur
            End If
        Next cel
        Print #1, StrTemp
    Next Lne
    Close
End Sub

 

[chocapic]

Re : Sauvegarde CSV

Vos 2 solutions fonctionnent, merci beaucoup 😀