Excel: macro pour exporter la feuille de calcul en tant que fichier CSV sans quitter ma feuille Excel actuelle

Il y a beaucoup de questions ici afin de créer une macro pour enregistrer une feuille de calcul dans un fichier CSV. Toutes les réponses utilisez le SaveAs, comme cette une de super-Utilisateur. Ils disent en gros que pour créer une fonction VBA comme ceci:

Sub SaveAsCSV()
    ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

C'est une grande réponse, mais je veux faire un à l'exportation au lieu de l'Enregistrer Comme. Lorsque le SaveAs est exécuté, il me fait deux problèmes: les

Mon fichier de travail en cours devient un fichier CSV. J'aimerais continuer à travailler dans mon original .fichier xlsm, mais pour exporter le contenu de la feuille de calcul en cours vers un fichier CSV avec le même nom.
Une boîte de dialogue s'affiche et vous demande de me confirmer que j'aimerais réécrire le fichier CSV.

Est-il possible de les exporter la feuille de calcul dans un fichier, mais de continuer à travailler dans mon fichier d'origine?

source d'informationauteur neves

@NathanClement était un peu plus rapide. Pourtant, voici le code complet (un peu plus élaboré):

Option Explicit

Public Sub ExportWorksheetAndSaveAsCSV()

Dim wbkExport As Workbook
Dim shtToExport As Worksheet

Set shtToExport = ThisWorkbook.Worksheets("Sheet1")     'Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False                       'Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:\tmp\test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False

End Sub

9

Presque ce que je voulais @Ralph. Votre code a quelques problèmes:
1. il exporte seulement les codée en dur de la feuille nommée "Feuil1";
2. il toujours d'exportation vers le même fichier temp, de l'écraser;
3. il ignore les paramètres régionaux de séparation char.
Pour résoudre ces problèmes, et de répondre à toutes mes exigences, j'ai adapté la code à partir d'ici. J'ai nettoyé un peu pour la rendre plus lisible.
```
Option Explicit
Sub ExportAsCSV()

    Dim MyFileName As String
    Dim CurrentWB As Workbook, TempWB As Workbook

    Set CurrentWB = ActiveWorkbook
    ActiveWorkbook.ActiveSheet.UsedRange.Copy

    Set TempWB = Application.Workbooks.Add(1)
    With TempWB.Sheets(1).Range("A1")
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteFormats
    End With        

    Dim Change below to "- 4"  to become compatible with .xls files
    MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

    Application.DisplayAlerts = False
    TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    TempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
End Sub
```
Il y a encore quelques petites chose avec le code ci-dessus que vous devriez remarquer:
1. .Close et DisplayAlerts=True devrait être dans une clause finally, mais je ne sais pas comment le faire en VBA
2. Il fonctionne seulement si le nom de fichier a 4 lettres, par exemple .xlsm. Ne pas travailler dans .xls excel fichiers. Pour les extensions de fichier de 3 caractères, vous devez modifier le - 5 à - 4 lors de la configuration de Monfichier.
3. Comme un effet collatéral, votre presse-papiers sera remplacé par feuille contenu.
Edit: mis Local:=True pour enregistrer mes paramètres régionaux CSV séparateur.

Comme pour mon commentaire sur @neves post, j'ai légèrement amélioré par l'ajout de la xlPasteFormats ainsi que les valeurs de la partie afin de dates d'aller sur les dates - j'ai surtout l'enregistrer comme un fichier CSV pour les relevés bancaires, il est donc nécessaire de dates.

"Sous ExportAsCSV()

Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
End With

'Dim Change below to "- 4"  to become compatible with .xls files
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"

Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub`

-2

Comme je l'ai commenté, il y a quelques endroits sur ce site que d'écrire le contenu d'une feuille de calcul vers un fichier CSV. Cette une et cette une de souligner que deux.

Ci-dessous est ma version

explicitement cherche "," à l'intérieur d'une cellule
Il utilise également UsedRange - parce que vous voulez pour obtenir la totalité du contenu de la feuille de calcul
Utilise un tableau pour la lecture en boucle que c'est plus rapide qu'en parcourant les cellules de la feuille
Je n'ai pas utilisé OFS routines, mais c'est une option

Le code ...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long

myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "\myCSV.csv" For Output Lock Write As #iFile

myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
    outStr = ""
    For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
        If InStr(1, myArr(iLoop, jLoop), ",") Then
            outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
        Else
            outStr = outStr & myArr(iLoop, jLoop) & ","
        End If
    Next jLoop
    If InStr(1, myArr(iLoop, jLoop), ",") Then
        outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
    Else
        outStr = outStr & myArr(iLoop, UBound(myArr, 2))
    End If
    Print #iFile, outStr
Next iLoop

Close iFile
Erase myArr

End Sub

Vous devez vous connecter pour publier un commentaire.