eric57
XLDnaute Occasionnel
Bonjour le Forum
Je souhaite enregistrer une feuille excel ( uniquement les 4 premières colonnes, pas les autres) en csv séparé par des virgules.
J'ai trouvé ce code donné par Roland_M, et adapté a mes besoins (4 col) et qui fonctionne très bien :
Mais je voudrais qu'il enregistre ce fichier d'après le contenue d'une cellule, j'ai donc essayé de modifier le code proposé par Job75 dans une autre discussion :
Ce code me plait bien car il contrôle le contenu de ma cellule avant l'enregistrement.
Peut-on faire une compil de ces 2 codes pour obtenir ce que j'ai besoin ?
Merci pour votre aide
Je souhaite enregistrer une feuille excel ( uniquement les 4 premières colonnes, pas les autres) en csv séparé par des virgules.
J'ai trouvé ce code donné par Roland_M, et adapté a mes besoins (4 col) et qui fonctionne très bien :
Sub ExportFile()
Chemin$ = ThisWorkbook.Path: Fichier$ = "predads.txt"
CheminFichier$ = Chemin$ & "\" & Fichier$
With Sheets("ETABLISSEMENT").UsedRange: NoDernLig& = .Cells(.Rows.Count, .Columns.Count).Row: End With
With Sheets("ETABLISSEMENT")
Open CheminFichier$ For Output As #1
For L& = 1 To NoDernLig&
V$ = .Cells(L&, 1) & "," & .Cells(L&, 2) & "," & .Cells(L&, 3) & "," & .Cells(L&, 4)
Print #1, V$
'Print #1, Right(V$, Len(V$) - 1) ' voir si comme ceci est utile !? sinon , V$ ça suffit !
Next
End With
Close #1
End Sub
Mais je voudrais qu'il enregistre ce fichier d'après le contenue d'une cellule, j'ai donc essayé de modifier le code proposé par Job75 dans une autre discussion :
Ce code me plait bien car il contrôle le contenu de ma cellule avant l'enregistrement.
bSub Enregistrer()
Dim Nom As String
Nom = Range("J1") & ".csv"
If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
SendKeys Nom
Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
Else
If Range("J1") = "" Then MsgBox "Entrez le nom du fichier en J1", 48: Range("J1").Select: Exit Sub
If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
On Error Resume Next
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
If Err Then MsgBox "Le nom proposé contient des caractères interdits", 48: Range("J1").Select
End If
End If
End Sub
Peut-on faire une compil de ces 2 codes pour obtenir ce que j'ai besoin ?
Merci pour votre aide