Как остановить переименование таблиц excel после запуска макроса сохранения

Ниже приведен макрос для сохранения нескольких листов в разные файлы csv, НО он продолжает переименовывать и сохранять исходную книгу, как это остановить.

Private Sub CommandButton1_Click()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long
Dim myName As String
myName = myName & Application.Cells(2, 2) 'cell B2 '

CurrentWorkbook = ThisWorkbook.FullName

CurrentFormat = ThisWorkbook.FileFormat

' Store current details for the workbook '

SaveToDirectory = "C:\temp\"

' Эта строка для исправления проблемы с косой чертой в форматировании кода Stackoverflow.

For Each WS In ThisWorkbook.Worksheets
  WS.SaveAs SaveToDirectory & myName & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = False
' Temporarily turn alerts off to prevent the user being prompted '
'  about overwriting the original file. '

End Sub

excel vba
person Community    schedule 30.12.2008    source источник
comment
Не могли бы вы правильно отформатировать код? Это действительно трудно читать.   -  person Tmdean    schedule 30.12.2008

Ответы (2)


arrow_upward
2
arrow_downward

ActiveWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat Application.DisplayAlerts = False

Если вы ничего не пишете в рабочей тетради, почему вы пытаетесь ее сохранить?

person shahkalpeshp    schedule 30.12.2008
comment
Цель состояла в том, чтобы сохранить каждый отдельный рабочий лист в отдельный CSV-файл из рабочей книги. Спасибо. - person ; 30.12.2008

arrow_upward
0
arrow_downward

Попробуй это:

Private Sub CommandButton1_Click()

    Dim WS As Excel.Worksheet
    Dim SaveToDirectory As String
    Dim myName As String
    Dim CurrentWorkbook As String

    ' Get the path to the curent workbook so we can open it later.
    CurrentWorkbook = ThisWorkbook.FullName

    SaveToDirectory = "C:\temp\"

    ' Turn off Excel alerts so we're not prompted if the file already exists.
    Application.DisplayAlerts = False

    For Each WS In ThisWorkbook.Worksheets
        WS.Activate                      ' Make this the current worksheet.
        myName = Application.Cells(2, 2) ' Get the contents of cell B2 for our file name.
        WS.SaveAs SaveToDirectory & myName & WS.Name, xlCSV
    Next

    ' Open the original workbook.
    Application.Workbooks.Open CurrentWorkbook

    ' Close workbook associated with the last saved worksheet.
    ThisWorkbook.Close xlDoNotSaveChanges

End Sub

Похоже, что метод Excel SaveAs делает сохраненный рабочий лист активной книгой, поэтому я просто закрываю его без сохранения.

person Patrick Cuff    schedule 30.12.2008
comment
Привет, Патрик. Я скопировал ваш макрос и, похоже, получил ошибку времени выполнения 1004, метод SaveAs объекта '_worksheet' не удался. Пожалуйста, помогите. - person ; 30.12.2008
comment
Это странно; между вашим кодом и моим кодом очень мало различий. Убедитесь, что вы вставили это правильно. Также измените SaveToDirectory на C:\temp\. - person Patrick Cuff; 30.12.2008
comment
Счастливого нового года всем. Пусть Новый год принесет всем здоровье и богатство. Привет, Патрик. Вставил весь код и все время получаю одно и то же сообщение об ошибке. Я также изменил каталог на c:\temp. Является ли это общей проблемой для Excel 2003 с пакетом обновления 3 (SP3)? Заранее благодарю. - person ; 05.01.2009
comment
Джон, я не могу воссоздать вашу проблему; код у меня работает нормально. Какова ваша безопасность на макроуровне? Попробуйте уменьшить его и посмотрите, поможет ли это. Также убедитесь, что у пользователя, запускающего макрос, есть права на запись в C:\temp. Кроме того, попробуйте заменить «xlCSV» на «6» в вызове SaveAs. - person Patrick Cuff; 05.01.2009
comment
ОК, я только что смог воссоздать проблему, изменив SaveToDirectory var на несуществующий путь (D:\temp для меня). Я думаю, что вы либо сохраняете по неверному пути, либо по пути, для которого у вас нет доступа для записи. - person Patrick Cuff; 05.01.2009