it-roy-ru.com

Excel: макрос для экспорта листа в виде файла CSV, не выходя из моего текущего листа Excel

Здесь много вопросов по созданию макроса для сохранения рабочего листа в виде файла CSV. Все ответы используют SaveAs, например этот от SuperUser. Они в основном говорят, чтобы создать функцию VBA, как это:

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

Это отличный ответ, но я хочу сделать export вместо Save As. Когда SaveAs выполняется, это вызывает у меня два раздражения:

  • Мой текущий рабочий файл становится файлом CSV. Я хотел бы продолжить работу в моем исходном файле .xlsm, но экспортировать содержимое текущего рабочего листа в файл CSV с тем же именем.
  • Появится диалоговое окно с просьбой подтвердить, что я хотел бы переписать файл CSV.

Можно ли просто экспортировать текущий лист в виде файла, но продолжить работу в моем исходном файле? 

18
neves

Почти то, что я хотел @Ralph. У вашего кода есть некоторые проблемы: 

  1. он экспортирует только жестко закодированный лист с именем «Sheet1»; 
  2. он всегда экспортирует в один и тот же временный файл, перезаписывая его; 
  3. он игнорирует разделительный символ локали. 

Чтобы решить эти проблемы и удовлетворить все мои требования, я адаптировал код отсюда . Я немного почистил его, чтобы сделать его более читабельным. 

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

В приведенном выше коде есть еще кое-что, что вы должны заметить:

  1. .Close и DisplayAlerts=True должны быть в пункте finally, но я не знаю, как это сделать в VBA
  2. Это работает, только если текущее имя файла имеет 4 буквы, например .xlsm. Не будет работать в .xls файлах Excel. Для расширений файлов из 3 символов вы должны изменить - 5 на - 4 при установке MyFileName.
  3. В качестве побочного эффекта ваш буфер обмена будет заменен текущим содержимым листа. 

Правка: поставить Local:=True, чтобы сохранить с моим языковым разделителем CSV. 

9
neves

@NathanClement был немного быстрее. Тем не менее, вот полный код (немного более сложный):

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

Согласно моему комментарию к посту @neves, я немного улучшил это, добавив xlPasteFormats, а также часть значений, чтобы даты совпадали с датами - я в основном сохраняю как CSV для выписок по счету, так что нужные даты.

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