|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
06.05.2011, 13:00 | #1 |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Макрос сохраниения листа книги
Здравствуйте Уважаемые форумчане!
Посздравляю Вас с наступающими праздниками, желаю счастья, здоровь, долгой и крепкой памяти! Помогите пожалуйста подправить макрос сохранения активного листа книги и при сохранении чтобы сохранялись (преобразовывались формулы в значения) только значения в сохраняемом листе, а оригенал листа оставался не изменимым. В книге есть несколько листов и на них стоит защита листов, при сохранении нужно чтобы защита листа как в сохраняемом, так и в оригинале книги осталось. Вот есть макрос, его и нужно подправить: Sub Save() Dim WbMain As Workbook Dim Wb As Workbook Dim FolderName As String Dim Date_name As String Application.EnableEvents = False Set WbMain = ActiveWorkbook FolderName = WbMain.Path & "\Archive" On Error Resume Next MkDir FolderName Date_name = CStr(InputBox("Введиту дату для текущего периода (пример: май 2011)! ", "Дата")) If Date_name <> Empty Then If ActiveWorkbook.Visible = -1 Then ActiveWorkbook.Copy я так понимаю нужно подправить что-то в выделения текста красным цветом Set Wb = ActiveWorkbook Wb.SaveAs FolderName _ & "\" & "Рапорт " & " " & Date_name & ".xls" 'Wb.Close False End If MsgBox "Книга " & ActiveSheet.Name & " в виде одного файла сохранен в папку " & FolderName End If Application.EnableEvents = True End Sub Заранение огромное спасибо!
Единственный способ стать умнее, играть с более умным противником...
|
06.05.2011, 14:17 | #2 |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Помогите пожалуста, уже сохранение сделал листа сделал. только ошибку выдает что форматы файлов отличаются, но книга открывается.
как убрать эту ошибку и как сохранять только значения листа?
Единственный способ стать умнее, играть с более умным противником...
|
06.05.2011, 14:23 | #3 |
Форумчанин
Регистрация: 25.04.2010
Сообщений: 616
|
Ранить не будем, сразу убьем.
Попробуйте так: Код:
|
06.05.2011, 14:39 | #4 | |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Цитата:
Sub Save() Dim WbMain As Workbook Dim Wb As Workbook Dim FolderName As String Dim Date_name As String 'Application.EnableEvents = False Application.ScreenUpdating = False Set WbMain = ActiveWorkbook FolderName = WbMain.Path & "\Archive" On Error Resume Next MkDir FolderName Date_name = CStr(InputBox("Введиту дату для текущего периода (пример: май 2011)! ", "Дата")) If Date_name <> Empty Then If ActiveWorkbook.Visible = -1 Then ActiveSheet.Unprotect ActiveSheet.Copy Cells.Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True Set Wb = ActiveWorkbook Wb.SaveAs FolderName _ & "\" & "Рапорт " & " " & Date_name & ".xls", FileFormat:=-4143 Wb.Close False End If End If MsgBox "Книга " & ActiveSheet.Name & " в виде одного файла сохранен в папку " & FolderName 'Application.EnableEvents = True Application.ScreenUpdating = True End Sub силь тупа я сделал?
Единственный способ стать умнее, играть с более умным противником...
|
|
06.05.2011, 14:59 | #5 | |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Цитата:
Единственный способ стать умнее, играть с более умным противником...
|
|
06.05.2011, 15:02 | #6 |
Форумчанин
Регистрация: 25.04.2010
Сообщений: 616
|
Вместо этого:
Код:
Код:
Код:
Последний раз редактировалось nilem; 06.05.2011 в 15:04. Причина: пишу долго :) |
11.05.2011, 12:34 | #7 | |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Цитата:
Код: Sub Save() If MsgBox("Сохранить рапорт в Архив?", vbYesNo, "Подтверждение") = vbYes Then Dim iyear As String, idate As Date Dim Wsh As Worksheet Dim FolderName As String Dim fg_ As String, fm_ As String 'Application.EnableEvents = False Application.ScreenUpdating = False FolderName = ThisWorkbook.Path & "\Archive" On Error Resume Next MkDir FolderName Set Wsh = ThisWorkbook.ActiveSheet: iyear = CStr(Year([B9])): idate = [B9] fg_ = Format(idate, "yyyy"): fm_ = Format(idate, "mmmm") If idate <> Empty Then If ActiveWorkbook.Visible = -1 Then ActiveSheet.Unprotect ActiveSheet.Copy With ActiveWorkbook .Sheets(1).Shapes(1).Delete With ActiveSheet.UsedRange: .Value = .Value: End With ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowFiltering:=True .SaveAs Filename:=FolderName & "\" & fg_ & "\" & fm_ & "\Рапорт " & Wsh.Name & " (" & idate & ").xls", FileFormat:=-4143 .Close False End With End If MsgBox "Лист " & Wsh.Name & " в виде одного файла сохранен в папку " & FolderName & "\" & fg_ & "\" & fm_ End If End If 'Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Единственный способ стать умнее, играть с более умным противником...
|
|
11.05.2011, 13:02 | #8 |
Форумчанин
Регистрация: 25.04.2010
Сообщений: 616
|
Переменная iyear не лишняя?
Первую строчку можно так: Код:
|
11.05.2011, 16:36 | #9 | |
Форумчанин
Регистрация: 16.04.2010
Сообщений: 695
|
Цитата:
Спасибо ))) я почти счастлив ))))
Единственный способ стать умнее, играть с более умным противником...
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Макрос постоянно обрабатывает события. При открытии другой книги макрос обрывается. | Ples | Microsoft Office Excel | 8 | 17.12.2016 18:15 |
Как перейти из макроса Книги в макрос листа | valerij | Microsoft Office Excel | 15 | 30.04.2011 01:51 |
выбор листа книги из ComboBox | prosto_i | Microsoft Office Excel | 0 | 08.04.2011 14:32 |
Макрос активной книги открывает книги xlsm содержащих auto_open | Daren | Microsoft Office Excel | 0 | 28.01.2011 09:34 |
снятие пароля с книги/листа из другой книги? | Bezdar | Microsoft Office Excel | 3 | 25.12.2008 11:59 |