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

Il y a beaucoup de questions ici pour créer une macro pour enregistrer une feuille de travail comme un fichier CSV. Toutes les réponses utilisez le SaveAs, comme celui-ci à partir de super-Utilisateur. Ils disent en gros de 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 exporter au lieu de sauver comme. Quand la Savée est exécutée, elle me cause deux ennuis:

  • mon fichier de travail actuel devient un fichier CSV. J'aimerais continuer je travaille dans mon original .XLSM, mais pour exporter le contenu de la feuille de travail courante vers un fichier CSV avec le même nom.
  • une boîte de dialogue s'affiche me demandant de confirmer que j'aimerais réécrire le fichier CSV.

est-il possible de simplement exporter la feuille de travail actuelle en tant que Fichier, mais de continuer à travailler dans mon fichier original?

16
demandé sur ashleedawg 2016-05-05 00:01:07

4 réponses

@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
19
répondu Ralph 2016-05-04 21:31:05

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 le char de séparation locale.

pour résoudre ces problèmes, et répondre à toutes mes exigences, j'ai adapté le code 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 chose avec le code ci-dessus que vous devriez remarquer:

  1. .Close et DisplayAlerts=True devrait être dans une clause finale, mais je ne sais pas comment le faire en VBA
  2. cela fonctionne Juste si le nom de fichier courant a 4 lettres, comme .xlsm. Ne pas travailler dans .xls excel fichiers. Pour les extensions de fichier de 3 caractères, vous devez changer le - 5- 4 lors de la configuration de MyFileName.
  3. comme effet collatéral, votre bloc-notes sera remplacé par la feuille courante contenu.

Edit: mettre Local:=True pour sauvegarder avec mon délimiteur CSV Local.

9
répondu neves 2017-12-20 19:07:03

comme dans mon commentaire sur @neves post, j'ai légèrement amélioré ceci en ajoutant la partie xlPasteFormats ainsi que les valeurs pour que les dates apparaissent comme des dates - j'économise la plupart du temps comme CSV pour les relevés bancaires, donc des 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
répondu Craig Lambie 2018-08-01 13:02:58
celui-ci et celui-ci à souligner que deux.

ci-dessous est ma version

  • explicitement cherche "," à l'intérieur d'une cellule
  • Il utilise aussi UsedRange - parce que vous voulez obtenir tout le contenu dans la feuille de travail
  • utilise un tableau pour boucler comme ceci est plus rapide que boucler à travers la feuille de travail les cellules
  • Je n'ai pas utilisé de routines FSO, 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
-2
répondu OldUgly 2017-05-23 10:31:30