Microsoft 365 *Resolu* VBA, Conversion en CSV sans derniere virgule

[alecuyer]

Bonjour à toutes et tous,

Je suis dans une impasse et voudrait bien de l'aide sur ce coup là.
J'ai trouvé ce code permettant de convertir plusieurs onglets en CSV. C'était parfait, nickel, rien à dire !

Option Explicit
Sub creer_CSV()


'================================================================
'              Exportation de feuilles en fichiers .CSV
'================================================================
Dim I&, j&, k&, Num&, Num2&
Dim Mes$, Fic$, Chem$, Separ$, All$
Dim Plg As Variant
Dim F As Worksheet
'================================================================
'                           Paramétrage
'================================================================
'Sufixe du fichier (èvite l'écrasement des fichiers précédents)
'Les fichiers porteront le nom des feuilles correspondantes plus le suffixe
Fic = "_" & Format(Date, "dd-mm-yyyy") & "_" & Format(Time, "h""H""mm") & ".csv"
'Chemin du dossier où seront crées les fichiers
' / ! \ Le chemin doit déja exister / ! \
Chem = "C:\temp"
'Séparateur utilisé pour la création des .CSV
Separ = ","
'Nom du fichier global
All = "All Gift Card"
'================================================================
'                           Traitement
'================================================================
'récupération d'un numéro de fichier non utilisé
Num = FreeFile
'Ouverture d'un fichier qui nous servira comme fichier global
Open Chem & "\" & All & Fic For Output As #Num
'Pour chaque feuille présentent dans le classeur actif
For Each F In ActiveWorkbook.Worksheets
    'récupération d'un numéro de fichier non utilisé
    Num2 = FreeFile
    'Déclaration de la valeur du tableau
    '(toute les données présentent sur la feuille)
    Plg = F.Range("A1").CurrentRegion.Value
    'Ouverture d'un fichier au nom de la feuille
    Open Chem & "\" & F.Name & Fic For Output As #Num2
        'Pour chaque ligne du tableau, sauf la première (+ 1) pour ne pas prendre les en tête de colonnes
        For I = LBound(Plg, 1) + 1 To UBound(Plg, 1)
            'Pour chaque colonne du tableau
            For j = LBound(Plg, 2) To UBound(Plg, 2)
                'Le message est ègal au message plus la valeur de la cellule
                ' en ligne i colonne j plus le séparateur ";"
                Mes = Mes & Plg(I, j) & Separ
            'Prochaine colonne
            Next j
            'Ecriture du message dans le fichier global
            Print #Num, Mes
            'Ecriture du message dans le fichier au nom de la feuille
            Print #Num2, Mes
            'Vide le message avant de passer à la ligne suivante
            Mes = ""
        'Ligne suivante
        Next I
    'Quand la boucle sur toutes les lignes du tableau est terminée
    'Fermeture du fichier au nom de la feuille
    Close #Num2
    'Suppression du tableau qui sera recréé à la prochaine feuille
    Erase Plg
'Prochaine feuille
Next F
'Fermeture du fichier global
Close #Num
'================================================================
'Boite de message pour la fin du traitement
MsgBox "Fichiers convertis en CSV dans C: Temp"
End Sub

Seulement je me suis aperçu que l'appli dans laquelle je doit uploder les données CSV n'accepte pas la dernière virgule (à la fin de la chaine).
J'ai ne trouve pas de solution

j'ai essayé avec ça

Sub sup_der_espace()
           Dim Rg As Range
        Application.ScreenUpdating = False
    With Cells(1).CurrentRegion.Columns(1)
           Set Rg = .Find("*,", , xlValues, xlWhole)
        If Not Rg Is Nothing Then
            Do
                 Rg.Value = Left(Rg.Value, Len(Rg.Value) - 1)
                   Set Rg = .FindNext(Rg)
            Loop Until Rg Is Nothing
        End If
    End With
        Application.ScreenUpdating = True
End Sub

Ca marche bien aussi mais... séparement.

Je souhaiterai que tout se fasse dans la même action. Ou alors que la 1ere macro ne me mette pas de virgule à la fin de la ligne.

Please, j'ai besoin de votre aide.
Merci
Aymeric

 

[alecuyer]

Merci bcp Job75, c'est top !!!

 

[alecuyer]

Je vous remercie tous pour votre aide !

 

[patricktoulon]

perso je prefere séparer les fonctions

exemple

Sub testz()
    Dim plage As Range
    Set plage = [A1].CurrentRegion
    MsgBox "la ligne d' entete du tableau est : " & vbCrLf & ligneCSV(plage, True)
    MsgBox "les ligne du tableau sont :" & vbCrLf & ligneCSV(plage)
End Sub
Function ligneCSV(plage, Optional Header As Boolean = False, Optional separ As String = ";")
   Dim I&, Fin&, Texte$
    With plage
        If Header Then
            ligneCSV = Join(Application.Index(Range(.Cells(1), .Cells(1, .Columns.Count + .Column - 1)).Value, 1, 0), separ)
        Else
            For I = plage.Row + 1 To plage.Rows.Count + .Row - 1
                Fin = Cells(I, 1).End(xlToRight).Column
                Texte = Texte & Join(Application.Index(Range(.Cells(I, 1), Cells(I, Fin)).Value, 1, 0), separ) & IIf(I < .Rows.Count + .Row - 1, vbCrLf, "")
            Next
            ligneCSV = Texte
        End If
    End With
End Function