XL 2016 Création fichier CSV

ZZ59264 · 19 Décembre 2021

Bonjour au forum,

Je joins un fichier à ma demande de création d'un fichier CSV à partir d'un tableau,

Merci d'avance pour votre aide,

Cordialement,

job75 · 20 Décembre 2021

Cette macro est la plus rapide :

VB:

Sub ExportCSV()
    Dim t, chemin$, NomFichier$
    t = Timer
    'chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    chemin = ThisWorkbook.Path & "\"
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy_mm_dd")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets("CSV").ListObjects(1).DataBodyRange
        Workbooks.Add 'nouveau document
        [A1].Resize(.Rows.Count, .Columns.Count) = .Value 'copie les valeurs
    End With
    With ActiveWorkbook
        .SaveAs Filename:=chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
    MsgBox Timer - t
End Sub

Toujours sur 900 000...

sylvanu · 19 Décembre 2021

Bonjour ZZ,
Un essai en PJ avec :

VB:

Sub ExportCSV()
    Dim Chemin$, NomFichier$: On Error GoTo Fin
    Chemin = "P:\AP\5 B\5 CSV IMPORT\" ' Ne pas oublier "\" à la fin
    NomFichier = "Export_" & Sheets("EN TETE").[AK2] & "_" & Year(Now) & "_" & Month(Now) & "_" & Day(Now) & ".csv"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets("CSV").Copy
    With ActiveWorkbook
        .SaveAs Filename:=Chemin & NomFichier, FileFormat:=xlCSV, local:=True
        .Close savechanges:=False
    End With
Fin:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Efgé · 19 Décembre 2021

Bonjour
une autre approche, sans la ligne d'en-tête comme demandé.

VB:

Sub export()
Dim Tbl As Variant
Dim FileNumber&, i&
Dim chemin$, Texte$

FileNumber = FreeFile
'chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
chemin = "P:\AP\5 B\5 CSV IMPORT\"
chemin = chemin & "Export_" & Sheets("EN TETE").Cells(2, 37) & Format(Date, "_YYYY_MM_DD") & ".csv"
Tbl = ListObjects("CSV").DataBodyRange

Open chemin For Output As #FileNumber
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    Texte = Join(Application.Index(Tbl, i), ";")
    Print #FileNumber, Texte
Next i
Close #FileNumber

End Sub

Cordialement

ChTi160 · 19 Décembre 2021

Bonjour
Efge
Y sert a quoi le i de la boucle ? Lol

VB:

For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    Texte = Join(Application.Index(Tbl, 1), ";")
    Print #FileNumber, Texte
Next i

Ne devrait il pas remplacer le 1 dans application.index
Bonne continuation
Jean marie

Efgé · 19 Décembre 2021

Re
Bonjour @ChTi160
Bien vu.
Je corrige

Cordialement

ZZ59264 · 19 Décembre 2021

Bonjour à tous,

J'ai testé le code VBA de Efgé, mais il bloque à ce niveau :

A votre avis pour quel raison? Pourriez vous m'expliquer chaque étape de votre code?,

Merci pour votre aide

ZZ59264 · 19 Décembre 2021

Bonjour Sylvanu,

J'ai testé votre proposition et la procédure se déroule bien,

Il y a juste le problème que la première ligne reste apparente?, et je ne sais pas comment modifier votre code pour obtenir ce qu'il me faut,

Cordialement,

cp4 · 19 Décembre 2021

ZZ59264 à dit:
Bonjour à tous,

J'ai testé le code VBA de Efgé, mais il bloque à ce niveau :

A votre avis pour quel raison? Pourriez vous m'expliquer chaque étape de votre code?,

Merci pour votre aide
Regarde la pièce jointe 1125153

Bonsoir, Syvanu, Efgé, Jean Marie, @ZZ59264

comme ceci

VB:

Tbl = Sheets("csv").ListObjects("CSV").DataBodyRange

ZZ59264 · 19 Décembre 2021

Bonsoir Cp4,

Merci pour votre retour, la procédure se passe sans problème et très rapidement,

Le hic c'est l'explication de cette procédure qui me parait très complexe, et j'aimerai connaitre l'explication pour chaque étape,

Merci pour tous ceux qui ont participé à mon post,

Cordialement,

cp4 · 19 Décembre 2021

ZZ59264 à dit:
Bonsoir Cp4,

Merci pour votre retour, la procédure se passe sans problème et très rapidement,

Le hic c'est l'explication de cette procédure qui me parait très complexe, et j'aimerai connaitre l'explication pour chaque étape,

Merci pour tous ceux qui ont participé à mon post,

Cordialement,

Je laisse le soin à Efgé de commenter son code. Mais tu peux faire une recherche sur fichier séquentiel.
C'est rapide parce que le traitement se fait en mémoire.

Bonne soirée.

patricktoulon · 19 Décembre 2021

Bonsoir
ça vous dirais de penser autrement ?
a adapter a votre cas
adapter votre chemin a votre guise

VB:

Sub test_by_patricktoulon()
    Dim chemin$, X&
    chemin = Environ("userprofile") & "\DeskTop\" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy-mm-dd") & ".csv"
    'Range("CSV[#all]").Copy    ' on copie le tableau structuré  entete compris
    Range("CSV").Copy           ' on copie le tableau structuré sans les entetes
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: texte = Replace(.GetText(1), vbTab, ";"): End With
    X = FreeFile: Open chemin For Output As #X: Print #X, texte: Close #X
    Application.CutCopyMode = False
End Sub

ZZ59264 · 19 Décembre 2021

patricktoulon à dit:

Bonsoir
ça vous dirais de penser autrement ?
a adapter a votre cas
adapter votre chemin a votre guise

VB:

Sub test_by_patricktoulon()
    Dim chemin$, X&
    chemin = Environ("userprofile") & "\DeskTop\" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy-mm-dd") & ".csv"
    'Range("CSV[#all]").Copy    ' on copie le tableau structuré  entete compris
    Range("CSV").Copy           ' on copie le tableau structuré sans les entetes
    With CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipboard: texte = Replace(.GetText(1), vbTab, ";"): End With
    X = FreeFile: Open chemin For Output As #X: Print #X, texte: Close #X
    Application.CutCopyMode = False
End Sub

Le problème c'est adapter ce code à mon exemple, surtout pour le Chemin? et je ne le comprends pas lol

IL est écrit plus court mais c'est quoi la différence avec le code de Efgé?,

Pourriez vous expliquer les étapes? a quoi correspond "("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

Merci d'avance,

Cordialement

cp4 · 19 Décembre 2021

patricktoulon à dit:
Bonsoir
ça vous dirais de penser autrement ?

à condition que tu déclares la variable Texte.
Sinon

Efgé · 19 Décembre 2021

Bonjour à tous
@patricktoulon

patricktoulon à dit:
chemin = Environ("userprofile") & "\DeskTop\" & Sheets("EN TETE").[AK2] & Format(Date, "_yyyy-mm-dd") & ".csv"

Ce n'est pas le demande. Ce qui amène la question :
"surtout pour le Chemin? et je ne le comprends pas"

Je plussois :

cp4 à dit:
à condition que tu déclares la variable Texte.

cp4 à dit:
Je laisse le soin à Efgé de commenter son code.

Voilà:

VB:

Sub export()
Dim Tbl As Variant
Dim FileNumber&, i&
Dim chemin$, Texte$

'Récupération d'un numéro de fichier mémoire vide
FileNumber = FreeFile
'chemin = CreateObject("WScript.Shell").specialFolders("Desktop") & "\"
'Création du nom du fichier (à la suite du chemein déjà donné
chemin = "P:\AP\5 B\5 CSV IMPORT\"
'Attribution du chemin de destination du fichier csv
chemin = chemin & "Export_" & Sheets("EN TETE").Cells(2, 37) & Format(Date, "_YYYY_MM_DD") & ".csv"
'Mise en mémoire (array) des données (DataBodyRange = données du tableau sans l'en-tête)
Tbl = Sheets("csv").ListObjects("CSV").DataBodyRange
'Ouverture et création du fichier de destination
Open chemin For Output As #FileNumber
'Pour chaque ligne i du tableau
For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    'On concatène la ligne i avec un ; en séparatuer
    Texte = Join(Application.Index(Tbl, i), ";")
    'On écrit le texte dans le fichier de destination
    Print #FileNumber, Texte
'Ligne i suivante
Next i
'On ferme le fichier de destination
Close #FileNumber

End Sub

Cordialement

ZZ59264 · 19 Décembre 2021

Bonsoir Efgé,

Merci beaucoup pour les commentaires qui me sont bien utiles et je trouve le code très rapide, donc cela me convient, surtout avec les explications pour ne pas appliquer bêtement et pouvoir le réutiliser dans d'autres cas,

Patrick toulon, qu'elle est la différence pour votre code, pouvez vous comment l'expliquez, car il est encore plus obscur pour un novice!!!

Merci à tous pour l'aide apportée,

Cordialement,

XL 2016 Création fichier CSV

ZZ59264

XLDnaute Occasionnel

Pièces jointes

job75

sylvanu

XLDnaute Barbatruc

Pièces jointes

Efgé

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

ZZ59264

XLDnaute Occasionnel

ZZ59264

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

ZZ59264

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

ZZ59264

XLDnaute Occasionnel

cp4

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

ZZ59264

XLDnaute Occasionnel

Discussions similaires