wake-up-neo.net

Excel: Makro, um ein Arbeitsblatt als CSV-Datei zu exportieren, ohne mein aktuelles Excel-Arbeitsblatt zu verlassen

Es gibt viele Fragen zum Erstellen eines Makros, um ein Arbeitsblatt als CSV-Datei zu speichern. Alle Antworten verwenden die SaveAs, wie this von SuperUser. Sie sagen im Grunde, eine VBA-Funktion wie folgt zu erstellen:

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

Dies ist eine großartige Antwort, aber ich möchte ein Exportieren anstelle von Speichern unter ausführen. Wenn das SaveAs ausgeführt wird, verursacht das zwei Ärgernisse:

  • Meine aktuelle Arbeitsdatei wird zu einer CSV-Datei. Ich möchte in meiner ursprünglichen XLSM-Datei weiterarbeiten, aber den Inhalt des aktuellen Arbeitsblatts in eine CSV-Datei mit demselben Namen exportieren.
  • Es erscheint ein Dialog, in dem Sie gefragt werden, ob ich die CSV-Datei neu schreiben möchte.

Ist es möglich, das aktuelle Arbeitsblatt nur als Datei zu exportieren, aber in meiner Originaldatei weiterzuarbeiten? 

excelvbaexcel-vbacsvexport-to-csv
18
neves

Fast was ich wollte @Ralph. Ihr Code hat einige Probleme: 

  1. es wird nur das hartcodierte Blatt mit dem Namen "Sheet1" exportiert. 
  2. es wird immer in dieselbe temporäre Datei exportiert und überschrieben; 
  3. es ignoriert die Locale-Trennzeichen. 

Um diese Probleme zu lösen und alle meine Anforderungen zu erfüllen, habe ich den Code von hier aus angepasst . Ich habe es ein wenig gesäubert, um es lesbarer zu machen. 

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

Es gibt noch einige Kleinigkeiten mit dem obigen Code, die Sie beachten sollten:

  1. .Close und DisplayAlerts=True sollten in einer finally-Klausel stehen, aber ich weiß nicht, wie sie dies in VBA tun soll
  2. Es funktioniert nur, wenn der aktuelle Dateiname 4 Buchstaben hat, wie .xlsm. Funktioniert nicht in XLS-Excel-Dateien. Bei Dateierweiterungen von 3 Zeichen müssen Sie - 5 in - 4 ändern, wenn Sie MyFileName festlegen.
  3. Als Nebeneffekt wird Ihre Zwischenablage durch den aktuellen Blattinhalt ersetzt. 

Bearbeiten: Fügen Sie Local:=True zum Speichern mit meinem CSV-Trennzeichen für das Gebietsschema ein. 

9
neves

@ NathanClement war etwas schneller. Hier ist jedoch der vollständige Code (etwas ausführlicher):

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

Wie in meinem Kommentar zu @neves post, habe ich dies etwas verbessert, indem ich die xlPasteFormats sowie den Werteteil so eingefügt habe, dass die Datumsangaben als Datumsangaben aufgeführt werden.

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