Добрый день! Подскажите, пожалуйста, как можно быстро закрепить области на всех листах? Если сгруппировать листы и закрепить область на одном листе, то это закрепление на другие листы не распространяется.
Добрый день! Подскажите, пожалуйста, как можно быстро закрепить области на всех листах? Если сгруппировать листы и закрепить область на одном листе, то это закрепление на другие листы не распространяется.Мурад
Попробуйте, например, такой процедурой (вставить в общий модуль): [vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets If Val(sh.Name) > 0 Then sh.Activate Set c0 = ActiveCell Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select End If Next sh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
Попробуйте, например, такой процедурой (вставить в общий модуль): [vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets If Val(sh.Name) > 0 Then sh.Activate Set c0 = ActiveCell Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select End If Next sh0.Activate Application.ScreenUpdating = True End Sub
А имена листов у вас точно как в примере - только "числовые"? Иначе вам надо убрать строчки if и end if, чтобы проверка не выполнялась (или прописать в условие собственную проверку имен листов).
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets ' If Val(sh.Name) > 0 Then sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select ' End If Next sh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
Тут ведь как - я предположил, что у вас, кроме этих листов, в книге и другие листы могут быть, которые закреплять не надо.
Ну и да - если у вас 2007/2010, то сохраните файл как файл с макросами (*.xlsm) и разрешите их исполнение...
А имена листов у вас точно как в примере - только "числовые"? Иначе вам надо убрать строчки if и end if, чтобы проверка не выполнялась (или прописать в условие собственную проверку имен листов).
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets ' If Val(sh.Name) > 0 Then sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select ' End If Next sh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
Тут ведь как - я предположил, что у вас, кроме этих листов, в книге и другие листы могут быть, которые закреплять не надо.
Ну и да - если у вас 2007/2010, то сохраните файл как файл с макросами (*.xlsm) и разрешите их исполнение...AndreTM
Skype: andre.tm.007 Donate: Qiwi: 9517375010
Сообщение отредактировал AndreTM - Понедельник, 25.05.2015, 12:09
Sub primer() Application.ScreenUpdating = False For Each sh In ThisWorkbook.Sheets sh.Activate With ActiveWindow .SplitColumn = 0'номер закрепленного столбца .SplitRow = 1'номер закрепленной строки End With ActiveWindow.FreezePanes = True Next sh Application.ScreenUpdating = True End Sub
[/vba] [p.s.]Количество листов сократила, а то файл по размеру не проходит. [/p.s.]
Вот еще пример:[vba]
Код
Sub primer() Application.ScreenUpdating = False For Each sh In ThisWorkbook.Sheets sh.Activate With ActiveWindow .SplitColumn = 0'номер закрепленного столбца .SplitRow = 1'номер закрепленной строки End With ActiveWindow.FreezePanes = True Next sh Application.ScreenUpdating = True End Sub
[/vba] [p.s.]Количество листов сократила, а то файл по размеру не проходит. [/p.s.]Manyasha
Всё работает. Только надо Option Explicit использовать и все переменные "обзывать"
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, sh As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select Next sh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
Всё работает. Только надо Option Explicit использовать и все переменные "обзывать"
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, sh As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ThisWorkbook.Sheets sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select Next sh0.Activate Application.ScreenUpdating = True End Sub
Alex_ST, я открыл файл со 132 листами, вставил Option Explicit, затем сразу под ним код, который Вы написали в своем посте. Запустил - никаких изменений или ошибок, просто частое моргание экрана и все.
Alex_ST, я открыл файл со 132 листами, вставил Option Explicit, затем сразу под ним код, который Вы написали в своем посте. Запустил - никаких изменений или ошибок, просто частое моргание экрана и все.Мурад
Моргание экрана??? Это с чего бы вдруг? Ведь в начале перед циклом стоит Application.ScreenUpdating = False, а по завершении Application.ScreenUpdating = True Ничего мигать не должно! Я бы, правда, написАл чуть по-другому - так, чтобы границы закрепления не задавались жёстко 2:2, а определялись по выделенной на активном в момент запуска листе ячейкой (ну не люблю я процедур с прописанными в теле диапазонами), но это сути не меняет. Код практически точно такой же, как у Андрея (AndreTM):
[vba]
Код
Sub freezeAll2() Dim oSh0 As Worksheet, oSh As Worksheet, rCell0 As Range, lRow&, lCol& Application.ScreenUpdating = False Set oSh0 = ActiveSheet: lRow = ActiveCell.Row: lCol = ActiveCell.Column For Each oSh In ThisWorkbook.Worksheets oSh.Activate Set rCell0 = ActiveCell ActiveWindow.FreezePanes = False Cells(lRow, lCol).Select ActiveWindow.FreezePanes = True rCell0.Select Next oSh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
К стати, код Вы поместили в стандартный модуль, надеюсь, а не в модуль листа?
Моргание экрана??? Это с чего бы вдруг? Ведь в начале перед циклом стоит Application.ScreenUpdating = False, а по завершении Application.ScreenUpdating = True Ничего мигать не должно! Я бы, правда, написАл чуть по-другому - так, чтобы границы закрепления не задавались жёстко 2:2, а определялись по выделенной на активном в момент запуска листе ячейкой (ну не люблю я процедур с прописанными в теле диапазонами), но это сути не меняет. Код практически точно такой же, как у Андрея (AndreTM):
[vba]
Код
Sub freezeAll2() Dim oSh0 As Worksheet, oSh As Worksheet, rCell0 As Range, lRow&, lCol& Application.ScreenUpdating = False Set oSh0 = ActiveSheet: lRow = ActiveCell.Row: lCol = ActiveCell.Column For Each oSh In ThisWorkbook.Worksheets oSh.Activate Set rCell0 = ActiveCell ActiveWindow.FreezePanes = False Cells(lRow, lCol).Select ActiveWindow.FreezePanes = True rCell0.Select Next oSh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
К стати, код Вы поместили в стандартный модуль, надеюсь, а не в модуль листа?Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Понедельник, 25.05.2015, 15:23
Я, к сожалению, свой файл-пример с работающим макросом выложить не могу - собаки-сисадмины не дают. Но у Вас какие-то чудеса... Попробуйте для начала на новом чистом файле. А может быть это кто-то из других процедур события смены листов или пересчёт перехватывает? Попробуйте-ка всё события запретить:
[vba]
Код
Sub freezeAll3() Dim oSh0 As Worksheet, oSh As Worksheet, rCell0 As Range, lRow&, lCol& With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With Set oSh0 = ActiveSheet: lRow = ActiveCell.Row: lCol = ActiveCell.Column For Each oSh In ThisWorkbook.Worksheets oSh.Activate Set rCell0 = ActiveCell ActiveWindow.FreezePanes = False Cells(lRow, lCol).Select ActiveWindow.FreezePanes = True rCell0.Select Next oSh0.Activate With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
[/vba]
Я, к сожалению, свой файл-пример с работающим макросом выложить не могу - собаки-сисадмины не дают. Но у Вас какие-то чудеса... Попробуйте для начала на новом чистом файле. А может быть это кто-то из других процедур события смены листов или пересчёт перехватывает? Попробуйте-ка всё события запретить:
[vba]
Код
Sub freezeAll3() Dim oSh0 As Worksheet, oSh As Worksheet, rCell0 As Range, lRow&, lCol& With Application: .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlManual: End With Set oSh0 = ActiveSheet: lRow = ActiveCell.Row: lCol = ActiveCell.Column For Each oSh In ThisWorkbook.Worksheets oSh.Activate Set rCell0 = ActiveCell ActiveWindow.FreezePanes = False Cells(lRow, lCol).Select ActiveWindow.FreezePanes = True rCell0.Select Next oSh0.Activate With Application: .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlAutomatic: End With End Sub
Спасибо, nilem!!! Заменил This на Active и заработало
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, sh As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ActiveWorkbook.Sheets sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select Next sh0.Activate Application.ScreenUpdating = True End Sub
[/vba]
Спасибо, nilem!!! Заменил This на Active и заработало
[vba]
Код
Sub freezeAll() Dim sh0 As Worksheet, sh As Worksheet, c0 As Range Application.ScreenUpdating = False Set sh0 = ActiveSheet For Each sh In ActiveWorkbook.Sheets sh.Activate Set c0 = ActiveCell ActiveWindow.FreezePanes = False Rows("2:2").Select ActiveWindow.FreezePanes = True c0.Select Next sh0.Activate Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
