如何在运行保存宏后停止重命名excelsheets

时间:2008-12-30 03:46:02

标签: excel vba excel-vba

下面是一个宏,可以将多个工作表保存到不同的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

2 个答案:

答案 0 :(得分:2)

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

如果您没有在工作簿上写任何内容,为什么要尝试保存它?

答案 1 :(得分:0)

试试这个:

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方法使保存的工作表成为活动工作簿,所以我只是关闭它而不保存。