Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 02.10.2008, 09:56   #1
IpS
 
Регистрация: 01.10.2008
Сообщений: 4
По умолчанию Сохранение текущего листа Excel в отдельный файл

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

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

Спасибо

P.S. Желательно с примером кода.
IpS вне форума
Старый 02.10.2008, 10:39   #2
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Назначьте своей кнопке макрос 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

Последний раз редактировалось EducatedFool; 02.10.2008 в 10:42.
EducatedFool вне форума
Старый 02.10.2008, 10:58   #3
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

Можно чуть проще:
Код:
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
Чем шире угол зрения, тем он тупее.
SAS888 вне форума
Старый 02.10.2008, 16:04   #4
IpS
 
Регистрация: 01.10.2008
Сообщений: 4
По умолчанию

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

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 вне форума
Старый 02.10.2008, 16:26   #5
IpS
 
Регистрация: 01.10.2008
Сообщений: 4
По умолчанию

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

Еще один вопрос: Можно ли при копировании листа, скопировать только текущее значения ячеек, без формул
IpS вне форума
Старый 02.10.2008, 17:48   #6
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

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

Код:
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

Последний раз редактировалось EducatedFool; 02.10.2008 в 17:51.
EducatedFool вне форума
Старый 03.10.2008, 05:08   #7
SAS888
Старожил
 
Аватар для SAS888
 
Регистрация: 05.12.2007
Сообщений: 4,180
По умолчанию

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

Последний раз редактировалось SAS888; 03.10.2008 в 06:53. Причина: Добавлено
SAS888 вне форума
Старый 03.10.2008, 13:10   #8
IpS
 
Регистрация: 01.10.2008
Сообщений: 4
По умолчанию

Спасибо .. все получилось.
IpS вне форума
Старый 04.10.2008, 10:39   #9
дмидми
Форумчанин
 
Аватар для дмидми
 
Регистрация: 06.03.2008
Сообщений: 352
По умолчанию

Метод SaveAs применим к объекту Worksheet. Зачем же создавать новую книгу?
дмидми вне форума
Старый 04.10.2008, 11:23   #10
EducatedFool
Программист VBA
СуперМодератор
 
Аватар для EducatedFool
 
Регистрация: 13.07.2008
Сообщений: 6,856
По умолчанию

Цитата:
Сообщение от дмидми Посмотреть сообщение
Метод SaveAs применим к объекту Worksheet. Зачем же создавать новую книгу?
Метод-то применим, вот только работает он (по крайней мере, у меня в Excel 2003) несколько странно... сохраняет почему-то не лист, а всю книгу.

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


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Excel: Удаление графиков и картинок с листа treiber Microsoft Office Excel 5 04.09.2008 13:22
Удалить строку листа Excel при выполнении условия Gennady Microsoft Office Excel 14 18.12.2007 13:54
как перенести данные с листа excel в текстовой фаил? sergey34 Microsoft Office Excel 6 02.12.2007 22:59