Можете ли вы иметь макрос Excel для автоматического сохранения копии в формате CSV

Question

Загрузка файла XLS представляет собой небольшую боль для быстрого приложения, которое мы создаем вместе (мы знаем, как это сделать, но это не стоит времени, особенно в C ++), поэтому мы собираемся использовать простой подходПользователь должен экспортировать копию в формате CSV.Однако, чтобы избавить их от проблем, мне было интересно, можно ли использовать макрос, который будет автоматически сохранять версию CSV всякий раз, когда они сохраняют XLS (X) в Excel 2007?

Обновление: После Тимора 'ответ, я немного покопался и придумал следующее:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
    TempFileName = Sourcewb.FullName + ".csv"

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Save the new workbook and close it
    With Destwb
        .SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
        .Close SaveChanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Это работает, за исключением того, что я не могу принудительно сохранить CSV, вместо того, чтобы спрашивать меня, хочу ли я перезаписать, даже после добавленияConflictResolution:=xlLocalSessionChanges

Answer 1

Оригинальная версия:

В редакторе VB в Excel выберите «ThisWorkbok» в левом меню навигации. В редакторе справа выберите «Книга» в раскрывающемся списке слева и «До сохранения» в правом.

Заменить макрос на:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    ActiveWorkbook.SaveCopyAs ActiveWorkbook.FullName + ".csv"
End Sub

Это сделает копию с расширением CSV.

Обратите внимание, что в файле XLSX не может быть макроса (вам нужно расширение XLSM или более старое XLS) и что пользователям потребуется средний или низкий уровень безопасности для запуска макроса (или вы должен подписать документ).

Отредактированная версия:

Я снова проверил это, увидев комментарии ниже. Как ни странно, это не сработало так, как в первый раз. Вот исправленная версия. Опять же, в части «Эта рабочая книга» редактора макросов:

Dim fInSaving As Boolean

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

If fInSaving Then
    Exit Sub
End If

fInSaving = True

Dim workbookName As String
Dim parentPath As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")

If SaveAsUI Then

    Dim result
    result = Application.GetSaveAsFilename

    If VarType(result) = vbBoolean Then
        If CBool(result) = False Then
            Exit Sub ' user cancelled the dialog box
        End If
    End If

    workbookName = fs.GetFileName(result)
    parentPath = fs.GetParentFolderName(result)
Else

    workbookName = ActiveWorkbook.name
    parentPath = ActiveWorkbook.path
End If


Dim index As Integer
index = InStr(workbookName, ".")

Dim name As String
name = Left(workbookName, index - 1)

' extension can be empty is user enters simply a name in the 'File / Save as' dialog
' so it is not computed (but hard-coded below)

' do not ask for confirmation to overwrite an existing file
Application.DisplayAlerts = False

' save a copy
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".csv"), XlFileFormat.xlCSV

' Save the normal workbook in the original name
ActiveWorkbook.SaveAs fs.BuildPath(parentPath, name & ".xlsm"), XlFileFormat.xlOpenXMLWorkbookMacroEnabled
Cancel = True

Application.DisplayAlerts = True
fInSaving = False
End Sub

Private Sub Workbook_Open()

    fInSaving = False
End Sub

Что удивительно, так это то, что вызов ActiveWorkbook.SaveAs снова запускает макрос => глобальное логическое значение для предотвращения бесконечной рекурсии.

Answer 2

, чтобы XL не спрашивал, хотите ли вы перезаписать, используйте Application.DisplayAlerts = False (и затем после сохранения сбрасываете значение в True)

Answer 3

Поскольку вопрос ОП относительно диалога сохранения, по-видимому, все еще открыт, хотя у Чарльза есть ответ относительно «действительно сохранить? Да? Вы уверены? Но этот файл существует? В любом случае? Абсолютно уверен?» предупреждение, я думал, что поделюсь полным сценарием с сообщениями предупреждения, отключенными ради полноты:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    Set Sourcewb = ActiveWorkbook
    TempFileName = Sourcewb.FullName + ".csv"

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Save the new workbook and close it
    With Destwb
        .SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
        .Close SaveChanges:=False
    End With

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub