Страницы: 1
RSS
сохранение листа книги в отдельный файл без макросов и кнопок
 
Здравствуйте.Уважаемые Специалисты!:)  
Помогите пожалуйста...  
Нужно сохранить данные в новый файл без макросов и кнопок на листе.  
Как вариант решения - можно также сохранить область печати.  
Огромное вам СПАСИБО!:)  
 
Sub save_me()  
Dim Rng As Range  
If Cells(1, 4) = "" Or Cells(6, 2) = "" Then  
MsgBox "Ячейки пусты!", 48, " Ошибка!"  
Exit Sub  
End If  
Sheets("Лист1").Copy  
Set Rng = Sheets("Лист1").UsedRange  
With Rng  
.Cells.Value = .Cells.Value  
End With  
ActiveWorkbook.SaveAs Filename:="C:\" & Cells(1, 4) & "_" & Cells(6, 2) & ".xls"  
ActiveWindow.Close  
End Sub
 
В чем вопрос - как сделать это вручную?  
Правый клик на ячрычке листа - Переместить/копировать - новая книга, создать копию. Сохраняете новую книгу.
 
Я думаю, в новом листе не должно быть макросов и кнопок.  
1. Если в исходном листе нет макросов, то и в новом не будет :)  
Т.е. может быть макросы из модуля листа можно перенести в общий модуль?  
Если нельзя - то ищите "ActiveWorkbook.VBProject.VBComponents"  
 
Вот, например, нашёл цитату:  
 
============================================================­==  
помогите пожалуйста убрать макро из отчета  
 
Yasha123,  
вот этот код всё удалил из активной книги:  
 
Sub DeleteModulesAndCode2()  
   Set iVBComponents = ActiveWorkbook.VBProject.VBComponents  
   For Each iVBComponent In iVBComponents  
       Select Case iVBComponent.Type  
           Case 1 To 3: iVBComponents.Remove iVBComponent  
           Case 100  
           With iVBComponent.CodeModule  
                .DeleteLines 1, .CountOfLines  
           End With  
       End Select  
   Next  
End Sub  
 
============================================================­==  
 
2. Кнопки можно удалить перебором, или если их одна/две, можно конкретно по имени и удалить.
 
Спасибо за ответы:) Не ожидал такой оперативности:)  
Но хотелось бы встроить это в код указанный выше.  
Чтобы был один макрос:)
 
Можно не встраивать - просто добавьте одну строку перед сохранением, а код положите рядом в модуль:  
 
DeleteModulesAndCode2  
ActiveWorkbook.SaveAs Filename:="C:\" & Cells(1, 4) & "_" & Cells(6, 2) & ".xls"  
ActiveWindow.Close  
End Sub  
 
Ну и ещё с кнопками разберитесь.  
Файлик (небольшой, без данных можно) показали бы, а то так вслепую может и не то советую...
 
Спасибо,Hugo!  
Сделал так как Вы сказали,но выскакивает ошибка в этой строке  
Set iVBComponents = ActiveWorkbook.VBProject.VBComponents
 
Нужно разрешить доступ к объектной модели или как-то так, нет под рукой XL2007/10.
 
Спасибо Вам,Hugo,огромное!:)С макросами разобрались:)  
Про то как доверить написано здесь:  
http://www.excel-vba.ru/chto-umeet-excel/kak-udalit-makrosy-v-knige/  
*правда пользовательские кнопки тот макрос не удаляет+ у Вас код короче:)  
 
Возможно ли отдельным макросом удалить все объекты на листе?  
Всёж их около 10:).Можно по одной конечно..  
 
ActiveSheet.Shapes(«Имя кнопки»).Delete  
 
но быть может есть способ красивее?;)  
 
Самое оптимальное,конечно если бы новый лист был бы сохранён как область печати:)Тем более у меня она присутствует:)
 
Пример:  
'Удаляем ВСЕ объекты на листе  
dim oSh as object  
for each oSh in ActiveSheet.Shapes  
   oSh.Delete  
next  
Application.ScreenUpdating = True  
End Sub  
 
Но лучше бы файл показали - вдруг там кнопки "не той системы" :)
 
Всё супер,Hugo!:)  
Низкий поклон Вам:)всё работает:)  
Спасибо огромное:)
 
{quote}{login=Hugo}{date=12.08.2011 12:41}{thema=}{post}Пример:  
'Удаляем ВСЕ объекты на листе  
dim oSh as object  
for each oSh in ActiveSheet.Shapes  
   oSh.Delete  
next  
Application.ScreenUpdating = True  
End Sub  
 
Но лучше бы файл показали - вдруг там кнопки "не той системы" :){/post}{/quote}  
 
мне на днях Уважаемый KukLP вот что поведал: Лист.DrawingObjects.Delete
Чебурашка стал символом олимпийских игр. А чего достиг ты?
Тишина - самый громкий звук


https://github.com/nervgh
 
Спасибо Сергею и Вам!:)  
Единственное но..  
Удаляет формы в текущем файле,но не сохранённом:)
 
Попробуйте  
ActiveSheet.DrawingObjects.Delete
 
Спасибо вам,Друзья!:)  
Подвожу итоги:  
 
Сохранение листа книги в отдельный файл без макросов и кнопок  
(новому файлу присваивается название взятому из ячеек,c проверкой на их заполнение)  
 
Добавьте два макроса:  
------------------  
Sub save_me()  
Application.ScreenUpdating = False  
Dim Rng As Range  
If Cells(1, 4) = "" Or Cells(6, 2) = "" Then  
MsgBox "Ячейки пусты!", 48, " Ошибка!"  
Exit Sub  
End If  
Sheets("Лист1").Copy  
Set Rng = Sheets("Лист1").UsedRange  
With Rng  
.Cells.Value = .Cells.Value  
End With  
DeleteModulesAndCode2  
ActiveSheet.DrawingObjects.Delete  
ActiveWorkbook.SaveAs Filename:="C:\" & Cells(1, 4) & "_" & Cells(6, 2) & ".xls"  
ActiveWindow.Close  
Application.ScreenUpdating = True  
End Sub  
------------------  
Sub DeleteModulesAndCode2()  
Set iVBComponents = ActiveWorkbook.VBProject.VBComponents  
For Each iVBComponent In iVBComponents  
Select Case iVBComponent.Type  
Case 1 To 3: iVBComponents.Remove iVBComponent  
Case 100  
With iVBComponent.CodeModule  
.DeleteLines 1, .CountOfLines  
End With  
End Select  
Next  
End Sub  
------------------  
Ещё раз...Огромное-преогромное спасибо всем Специалистам!:)
Страницы: 1
Читают тему
Наверх