Страницы: 1
RSS
Как задать область печати для всех страниц?
 
Добрый день! Есть макрос, который создает новые листы в книге по шаблону. Всё работает прекрасно, кроме одного - шаблон представляет собой таблицу, которая должна помещаться на одном листе, но вот во вновь создаваемых листах приходится вручную заходить в параметры страницы и выбирать "Разместить на одной странице" ((( А это отнимает очень много времени и душевных сил, когда листов около 100. Может есть варианты, как доработать макрос? Буду признательна всем за идеи!
Код
Sub primer()

Application.ScreenUpdating = False

For i = 2 To Worksheets("реестр").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets.Add
    sn = ActiveSheet.Name
    Worksheets("Шаблон").Cells.Copy Worksheets(sn).Cells(1, 1)
    Worksheets(sn).Cells(5, 3) = Worksheets("реестр").Cells(i, 1)
    Worksheets(sn).Cells(5, 5) = Worksheets("реестр").Cells(i, 2)
    Worksheets(sn).Cells(7, 3) = Worksheets("реестр").Cells(i, 3)
    Worksheets(sn).Cells(8, 2) = Worksheets("реестр").Cells(i, 5)
    Worksheets(sn).Cells(16, 2) = Worksheets("реестр").Cells(i, 4)
    Worksheets(sn).Cells(17, 4) = Worksheets("реестр").Cells(i, 6)
    Worksheets(sn).Cells(24, 2) = Worksheets("реестр").Cells(i, 2)
Next i

Application.ScreenUpdating = True

End Sub
Изменено: olga1986 - 30.09.2016 12:53:49
 
olga1986, код следует оформлять соответствующим тегом. Ищите такую кнопку и исправьте своё сообщение.
Спасибо!
 
Можете без макроса выделить все листы (Shift+ЛКМ по 1 листу затем Shift+ЛКМ по последнему; либо ПКМ на любом ярлыке листа и "Выделить все листы"), зайти в параметры страницы и поставить галочку "Разместить не более чем на 1 странице" применяется ко всем выделенным. Только не знаю насколько Excel "задумается" если листов так много.
 
Юрий М, спасибо за замечание. Сообщение исправила.
 
venom51, всё гениальное - просто))) спасибо большое за совет! РАБОТАЕТ!
 
А если надо макросом, то
Код
Public Sub tet()
    Dim iWS As Worksheet
    
    For Each iWS In ThisWorkbook.Worksheets
    With iWS.PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    Next iWS
End Sub
Арфы - нет, возьмите бубен.
Страницы: 1
Читают тему
Наверх