Сохранение текущего листа Excel в отдельный файл

[IpS]

Доброго всем времени суток!

Помогите справиться с небольшой проблемкой.
Есть файл Excel с несколькими листами. Сделал ToolBar с кнопками. Как реализовать кнопку "Сохранить как" только для текущего листа. т. е. чтобы при нажатии на кнопку можно было выбрать директорию и имя файла, и текущий лист сохранялся бы в отдельный файл (.txt .xls)

Спасибо

P.S. Желательно с примером кода.

[EducatedFool]

Назначьте своей кнопке макрос SaveActiveSheet

Sub SaveActiveSheet()
    On Error Resume Next
    If ActiveSheet Is Nothing Then Exit Sub
    NewFileName = GetNewFileName
    If Len(NewFileName) > 0 Then
        ActiveSheet.Copy
        ActiveWorkbook.SaveAs NewFileName
        ActiveWorkbook.Close False
    End If
End Sub

Function GetNewFileName() As String
    GetNewFileName = ""
    InitialFileName = "c:\"
    NewFileExt = ".xls"
    GetNewFileName = Application.GetSaveAsFilename(InitialFileName, _
                                                   "Листы Excel (*" & NewFileExt & "),", , _
                                                   "Введите имя файла для сохранения листа", "Сохранить лист")
    If VarType(GetNewFileName) = vbBoolean Then GetNewFileName = "": Exit Function
    If GetNewFileName = "False" Or GetNewFileName = "Ложь" Then GetNewFileName = ""
End Function

[SAS888]

Можно чуть проще:

Sub SheetToFile()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Dim ShName As String, FName As String
    ShName = ActiveSheet.Name
    Workbooks.Add xlWBATWorksheet
    ThisWorkbook.Sheets(ShName).Cells.Copy ActiveWorkbook.Sheets(1).[A1]
    FName = Application.GetSaveAsFilename(InitialFileName:=ShName, _
        FileFilter:="Excel Files (*.xls), *.xls", Title:="Выберите папку для сохранения")
    ActiveWorkbook.Close saveChanges:=True, Filename:=FName
End Sub

[IpS]

Спасибо за помощь

2EducatedFool:

В твоем варианте выполнение кода остановилось на строчке:
ActiveSheet.Copy

Сообщение от SAS888

Можно чуть проще:

Sub SheetToFile()
    Application.ScreenUpdating = False: Application.DisplayAlerts = False
    Dim ShName As String, FName As String
    ShName = ActiveSheet.Name
    Workbooks.Add xlWBATWorksheet
    ThisWorkbook.Sheets(ShName).Cells.Copy ActiveWorkbook.Sheets(1).[A1]
    FName = Application.GetSaveAsFilename(InitialFileName:=ShName, _
        FileFilter:="Excel Files (*.xls), *.xls", Title:="Выберите папку для сохранения")
    ActiveWorkbook.Close saveChanges:=True, Filename:=FName
End Sub

Здесь он скопировал в принципе текущий лист, пересчитав ячейки в новую книгу с одним листом, что в принципе то, чего я хотел, однако сохранил он не эту книгу с нужным листом, а ту, из которой копировали со всеми листами, после закрыв ее.
Т.е. как сделать чтобы он сохранил вновь созданную книгу с одним листом, и потом закрыл ее?

[IpS]

Хотя попробовал еще раз, получилось нормально...

Еще один вопрос: Можно ли при копировании листа, скопировать только текущее значения ячеек, без формул

[EducatedFool]

Попробуйте этот код... Написан он не лучшим образом, но работает.

Sub SaveActiveSheet()
    On Error Resume Next

    Dim Sh As Worksheet: Set Sh = ActiveSheet
    If Sh Is Nothing Then Exit Sub
    SU False: DA False
    NewFileName = GetNewFileName
    If Len(NewFileName) > 0 Then
        Sh.Copy
        ActiveWorkbook.ActiveSheet.Cells.Copy
        ActiveWorkbook.ActiveSheet.Cells.PasteSpecial xlPasteValuesAndNumberFormats
        ActiveWorkbook.SaveAs NewFileName
        ActiveWorkbook.Close False
    End If
    SU True: DA True: set sh=nothing
End Sub

Sub SU(ByVal Update_Screen As Boolean): Application.ScreenUpdating = Update_Screen: End Sub
Sub DA(ByVal Display_Alerts As Boolean): Application.DisplayAlerts = Display_Alerts: End Sub

Function GetNewFileName() As String
    GetNewFileName = "":    InitialFileName = "c:\": NewFileExt = ".xls"
    GetNewFileName = Application.GetSaveAsFilename(InitialFileName, _
                                                   "Листы Excel (*" & NewFileExt & "),", , _
                                                   "Введите имя файла", "Сохранить лист")
    If VarType(GetNewFileName) = vbBoolean Then GetNewFileName = "": Exit Function
    If GetNewFileName = "False" Or GetNewFileName = "Ложь" Then GetNewFileName = ""
End Function

[SAS888]

После создания рабочей книги с одним листом (строка кода "Workbooks.Add xlWBATWorksheet"), она автоматически становится активной. Затем она же и сохраняется: "ActiveWorkbook.Close saveChanges:=True, Filename:=FName". Все как надо. А чтобы в этой книге получить только значения (без формул), перед этой строкой нужно вставить

ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

Можно, конечно, при копировании вставлять только значения, но тогда не будут скопированы размеры строк и столбцов, цвета шрифтов и ячеек и т.п. Понадобятся дополнительные "телодвижения" (что менее рационально).

[IpS]

Спасибо .. все получилось.

[дмидми]

Метод SaveAs применим к объекту Worksheet. Зачем же создавать новую книгу?

[EducatedFool]

Сообщение от дмидми

Метод SaveAs применим к объекту Worksheet. Зачем же создавать новую книгу?

Метод-то применим, вот только работает он (по крайней мере, у меня в Excel 2003) несколько странно... сохраняет почему-то не лист, а всю книгу.

То есть для книги с несколькими листами вызов activesheet.saveas аналогичен по результату activeworkbook.saveas