Здравствуйте, уважаемые форумчане! Перебираю циклом каждый лист в книге и задаю параметры страницы. В книге порядка 300 листов. Когда применяю макрос, Excel зависает в связи с переполнением памяти. Подскажите, пожалуйста, как можно ускорить макрос?
Код
Sub Параметры()
For Each xWorksheet In ActiveWorkbook.Worksheets
With xWorksheet.PageSetup
.FitToPagesWide = 1
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.PrintTitleRows = "$5:$7"
End With
Next xWorksheet
End Sub
Здравствуйте. А попробуйте не перебором, а выделить все нужные листы и задать им параметры. Возможно так не все параметры можно задать, а может и получится. А возможно в связи с изменением параметров, что то происходит на листах, пересчитываются какие нибудь формулы. Попробуйте выключить ненужные процедуры на время выполнения этого макроса.
Сначала сгруппировал листы, затем применил параметры. Но дело в том, что почему-то не задаются сквозные строки. Подскажите, пожалуйста, что не так в коде?
Код
Sub листы()
Dim s()
k = Sheets.Count
ReDim s(5 To k)
For i = 5 To k
s(i) = i
Next
Sheets(s).Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1000
.Orientation = xlLandscape
.LeftMargin = Application.InchesToPoints(0.196850393700787)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.CenterHorizontally = True
.PrintTitleRows = "$5:$7"
End With
Application.PrintCommunication = True
Sheets("Лист1").Select
End Sub
Добрый день! Да, есть такой баг, связанный с PrintTitleRows, начиная с версии 2007. Попробуйте этой свойство присвоить отдельным циклом (перед строкой 27 из #5).
Код
For i = 5 To k
Sheets(i).PageSetup.PrintTitleRows = "$5:$7"
Next