web-dev-qa-db-fra.com

Excel: macro pour exporter une feuille de calcul au format CSV sans quitter ma feuille Excel actuelle

Il y a beaucoup de questions ici pour créer une macro pour enregistrer une feuille de calcul au format CSV. Toutes les réponses utilisent le SaveAs, comme celui-ci de SuperUser. Ils disent essentiellement de créer une fonction VBA comme ceci:

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

C'est une excellente réponse, mais je souhaite effectuer un export au lieu de Enregistrer sous. Lorsque le SaveAs est exécuté, cela me cause deux ennuis:

  • Mon fichier de travail actuel devient un fichier CSV. J'aimerais continuer à travailler dans mon fichier .xlsm d'origine, mais à exporter le contenu de la feuille de calcul actuelle dans un fichier CSV portant le même nom.
  • Une boîte de dialogue apparaît et me demande de confirmer que je souhaite réécrire le fichier CSV.

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

excelvbaexcel-vbacsvexport-to-csv
18
neves

Presque ce que je voulais @Ralph. Votre code a quelques problèmes: 

  1. il exporte uniquement la feuille codée en dur nommée "Sheet1"; 
  2. il exporte toujours vers le même fichier temporaire, en le remplaçant; 
  3. il ignore le caractère de séparation des paramètres régionaux. 

Pour résoudre ces problèmes et répondre à toutes mes exigences, j'ai adapté le code à partir d'ici . Je l'ai un peu nettoyé pour le 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 choses avec le code ci-dessus que vous devriez remarquer:

  1. .Close et DisplayAlerts=True devraient être dans une clause finally, mais je ne sais pas comment le faire dans VBA
  2. Cela fonctionne seulement si le nom de fichier actuel a 4 lettres, comme .xlsm. Ne fonctionnerait pas dans les fichiers Excel .xls. Pour les extensions de fichier de 3 caractères, vous devez modifier le - 5 en - 4 lors de la définition de MyFileName.
  3. En tant que garantie, votre presse-papiers sera remplacé par le contenu actuel de la feuille. 

Edit: mettez Local:=True pour enregistrer avec le délimiteur CSV de vos paramètres régionaux. 

9
neves

@NathanClement était un peu plus rapide. Pourtant, voici le code complet (légèrement 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
20
Ralph

Selon mon commentaire sur @neves post, j’ai légèrement amélioré cela en ajoutant les éléments xlPasteFormats ainsi que les valeurs afin que les dates apparaissent sous forme de dates - j’enregistre principalement au format CSV pour les relevés bancaires, dates nécessaires.

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
0
Craig Lambie