Страницы: 1
RSS
Запуск макроса при закрытии книги
 
Требуется запускать макрос при каждом закрытии книги.  
Как альтернатива при ее сохранении.  
Что и как необходимо сделать?  
(если можно алгоритм действий)  
 
Сам макрос:  
 
Sub Макрос6()  
'  
' Макрос6 Макрос  
' Макрос записан 23.08.2010 (Nikolay)  
'  
 
'  
   Sheets("Лист1").Select  
   Range("D70:I84").Select  
   Selection.Copy  
   Sheets("Архив").Select  
   Cells.Find(What:="666666", After:=ActiveCell, LookIn:=xlValues, LookAt _  
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _  
       False, SearchFormat:=False).Activate  
   ActiveCell.Offset(0, 2).Range("A1").Select  
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
       :=False, Transpose:=False  
   Sheets("Объекты (2)").Select  
   ActiveCell.Range("A1:C1").Select  
End Sub
 
В модуль книги:  
Private Sub Workbook_BeforeClose(Cancel As Boolean)  
' Макрос записан 23.08.2010 (Nikolay)  
Sheets("Лист1").Range("D70:I84").Copy  
Sheets("Архив").Select  
Cells.Find(What:="666666", After:=ActiveCell, LookIn:=xlValues, LookAt _  
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _  
False, SearchFormat:=False).Activate  
ActiveCell.Offset(0, 2).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _  
:=False, Transpose:=False  
Sheets("Объекты (2)").Select  
ActiveCell.Range("A1:C1").Select  
End Sub
Я сам - дурнее всякого примера! ...
 
Можно немного оптимизировать макрос:  
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)  
   Макрос6  
End Sub  
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)  
   Макрос6  
End Sub  
 
Sub Макрос6()  
   Dim ЯчейкаДляВставки As Range  
   Set ЯчейкаДляВставки = Sheets("Архив").UsedRange.Find(What:="666666").Offset(, 2)  
   Sheets("Лист1").Range("D70:I84").Copy ЯчейкаДляВставки  
End Sub  
 
 
Вставьте весь этот код в модуль книги.
 
Игорь, автору надо вставлять значения. А просто Copy вставит все. А дальше он активирует Sheets("Объекты (2)") с выделением диапазона(не знаю зачем, но мож так надо)... Я не стал трогать.
Я сам - дурнее всякого примера! ...
 

Спасибо за участие. Но что то не выходит :(. Если не сложно прошу помочь вставить макрос в книгу.Sub Макрос1()<BR>'<BR>' Макрос1 Макрос<BR>' Макрос записан 23.08.2010 (Nikolay)<BR>'

'<BR>    Sheets("Лист1").Select<BR>    Range("D70:I84").Select<BR>    Selection.Copy<BR>    Sheets("Архив").Select<BR>    Range("A2").Select<BR>    Cells.Find(What:="666666", After:=ActiveCell, LookIn:=xlValues, LookAt _<BR>        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _<BR>        False, SearchFormat:=False).Activate<BR>    ActiveCell.Offset(0, 2).Range("A1").Select<BR>    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<BR>        :=False, Transpose:=False<BR>    ActiveCell.Offset(-32, -2).Range("A1").Select<BR>    Sheets("Объекты").Select<BR>    ActiveCell.Range("A1:C1").Select<BR>End Sub <BR><STRONG>Файл удален</STRONG> - велик размер. [Модераторы]

Я сам - дурнее всякого примера! ...
 
nik105, Вы бы правила почитали по поводу размера файла. И еще. Очень не понравилось, сто Вы подписались моим ником в последнем сообщении. Ваш файл модеры удалят. Поэтому потрудитесь выложить тот же файл сжатый раром или зипом. И подпишитесь своим ником.  
С ув. Сергей.
Я сам - дурнее всякого примера! ...
 
Я уже писал:"В модуль книги:". А Вы в общий модуль вставили. Понимаю, с ВБА туго.  
Держите ответ и не нарушайте правил(надеюсь меня за это модеры простят).
Я сам - дурнее всякого примера! ...
 
Здравствуйте, Сергей.  
Большое спасибо за помощь.  
Прошу прощения, что подписался Вашим именем, хотел отправить личное сообщение    
(не много не разобрался, а исправить не сумел).  
Впредь буду внимательнее.  
 
С уважением, Николай.
Страницы: 1
Читают тему
Наверх