Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Выбор последней и предпоследней страницы при печати - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор последней и предпоследней страницы при печати (Макросы/Sub)
Выбор последней и предпоследней страницы при печати
maksimolololllka Дата: Понедельник, 16.01.2023, 17:11 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
Есть необходимость при печати осуществлять масштабирование и печать определенных страниц.

Макрос удалось создать при помощи записи действий, но нужно доработать следующий момент:
При выводе на печать может быть минимум 3 листа, максимум неограничен.
Печатаются сначала 1 и последняя страница в определенном масштабе, а все что между - другое форматирование.
Если страниц для печати 3 - то все ок, создается шаблон под него, но если листов 4 и более, то в коде нужно указать обозначение предпоследней и последней страницы.

Вопрос в том как сделать макрос универсальным для любого количества страниц на печати.
 
Ответить
СообщениеДобрый день!
Есть необходимость при печати осуществлять масштабирование и печать определенных страниц.

Макрос удалось создать при помощи записи действий, но нужно доработать следующий момент:
При выводе на печать может быть минимум 3 листа, максимум неограничен.
Печатаются сначала 1 и последняя страница в определенном масштабе, а все что между - другое форматирование.
Если страниц для печати 3 - то все ок, создается шаблон под него, но если листов 4 и более, то в коде нужно указать обозначение предпоследней и последней страницы.

Вопрос в том как сделать макрос универсальным для любого количества страниц на печати.

Автор - maksimolololllka
Дата добавления - 16.01.2023 в 17:11
maksimolololllka Дата: Понедельник, 16.01.2023, 17:11 | Сообщение № 2
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

[vba]
Код

Sub Выписка3листа()
'
' Выписка3листа Макрос
'
' Сочетание клавиш: Ctrl+z
'
    ActiveWindow.SmallScroll Down:=-60
    Range("1:10,22:22").Select
    Range("A22").Activate
    Selection.Delete Shift:=xlUp
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AO$54"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AO$54"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код

Sub Выписка3листа()
'
' Выписка3листа Макрос
'
' Сочетание клавиш: Ctrl+z
'
    ActiveWindow.SmallScroll Down:=-60
    Range("1:10,22:22").Select
    Range("A22").Activate
    Selection.Delete Shift:=xlUp
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AO$54"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    ActiveWindow.SelectedSheets.PrintOut From:=3, To:=3, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$1:$AO$54"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 300
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = False
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut From:=2, To:=2, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
End Sub
[/vba]

Автор - maksimolololllka
Дата добавления - 16.01.2023 в 17:11
_Boroda_ Дата: Понедельник, 16.01.2023, 17:38 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
[vba]
Код
KolStran = ExecuteExcel4Macro("GET.DOCUMENT(50)")
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение[vba]
Код
KolStran = ExecuteExcel4Macro("GET.DOCUMENT(50)")
[/vba]

Автор - _Boroda_
Дата добавления - 16.01.2023 в 17:38
maksimolololllka Дата: Вторник, 17.01.2023, 12:21 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

KolStran = ExecuteExcel4Macro("GET.DOCUMENT(50)")


Спасибо! Отличный счетчик!
Подскажите, пожалуйста, решил проверить сколько он насчитает листов на печать, при выводе количества через MsgBox, получаю количество 3, вместо реальных 50 (другой документ, где как раз больше данных). Иногда выдает верное значение при ручном пролистывании всей таблицы, но перенос на последнюю ячейку делу не помог.
К сообщению приложен файл: 4773822.png(1.2 Kb) · 1673623.png(0.6 Kb)
 
Ответить
Сообщение
KolStran = ExecuteExcel4Macro("GET.DOCUMENT(50)")


Спасибо! Отличный счетчик!
Подскажите, пожалуйста, решил проверить сколько он насчитает листов на печать, при выводе количества через MsgBox, получаю количество 3, вместо реальных 50 (другой документ, где как раз больше данных). Иногда выдает верное значение при ручном пролистывании всей таблицы, но перенос на последнюю ячейку делу не помог.

Автор - maksimolololllka
Дата добавления - 17.01.2023 в 12:21
_Boroda_ Дата: Вторник, 17.01.2023, 13:12 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Попробуйте явно указать книгу и лист
Типа вот так
[vba]
Код
KolStran  = ExecuteExcel4Macro ("GET.DOCUMENT(50,""[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & """)")
[/vba]

Или вот так попробуйте
[vba]
Код
    Application.ScreenUpdating = 0
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.View = xlNormalView
    olStran = ExecuteExcel4Macro("GET.DOCUMENT(50,""[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & """)")
    Application.ScreenUpdating = 1
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПопробуйте явно указать книгу и лист
Типа вот так
[vba]
Код
KolStran  = ExecuteExcel4Macro ("GET.DOCUMENT(50,""[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & """)")
[/vba]

Или вот так попробуйте
[vba]
Код
    Application.ScreenUpdating = 0
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.View = xlNormalView
    olStran = ExecuteExcel4Macro("GET.DOCUMENT(50,""[" & ActiveWorkbook.Name & "]" & ActiveSheet.Name & """)")
    Application.ScreenUpdating = 1
[/vba]

Автор - _Boroda_
Дата добавления - 17.01.2023 в 13:12
maksimolololllka Дата: Вторник, 17.01.2023, 15:36 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Попробуйте явно указать книгу и лист
Типа вот так


Дело в том, что имя книги и листа все время меняется. Идея генерация файлов с разными именами, листы также имеют разные названия. Но лист всегда один, запуск из личной книги макросов.

Нашел на просторах счетчик, который исправно определяет количество страниц:
[vba]
Код
Sub Pages_Count()
Dim Pages_Count As Long, sh
For Each sh In ThisWorkbook.Sheets 'ActiveWorkbook.Sheets
'Pages_Count = Pages_Count + sh.PageSetup.Pages.Count
sh.Activate: Pages_Count = Pages_Count + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next
MsgBox "Будет распечатано страниц: " & Pages_Count
End Sub
[/vba]

Подскажите, как его грамотно интегрировать в код при печати страниц в конце кода со второй до предпоследней? При добавлении у меня выдает 1004 ошибку, приходится перезагружать файл с таблицей, иначе исправления не помогают.
 
Ответить
Сообщение
Попробуйте явно указать книгу и лист
Типа вот так


Дело в том, что имя книги и листа все время меняется. Идея генерация файлов с разными именами, листы также имеют разные названия. Но лист всегда один, запуск из личной книги макросов.

Нашел на просторах счетчик, который исправно определяет количество страниц:
[vba]
Код
Sub Pages_Count()
Dim Pages_Count As Long, sh
For Each sh In ThisWorkbook.Sheets 'ActiveWorkbook.Sheets
'Pages_Count = Pages_Count + sh.PageSetup.Pages.Count
sh.Activate: Pages_Count = Pages_Count + ExecuteExcel4Macro("GET.DOCUMENT(50)")
Next
MsgBox "Будет распечатано страниц: " & Pages_Count
End Sub
[/vba]

Подскажите, как его грамотно интегрировать в код при печати страниц в конце кода со второй до предпоследней? При добавлении у меня выдает 1004 ошибку, приходится перезагружать файл с таблицей, иначе исправления не помогают.

Автор - maksimolololllka
Дата добавления - 17.01.2023 в 15:36
_Boroda_ Дата: Вторник, 17.01.2023, 15:43 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16550
Репутация: 6441 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
Дело в том, что имя книги и листа все время меняется
Именно поэтому я и написал ActiveWorkbook и ActiveSheet

Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
Нашел на просторах счетчик
Это же одно и то же, Вы разве не видите?

Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
как его грамотно интегрировать в код при печати страниц в конце кода со второй до предпоследней?
А Вы как делаете-то?
[vba]
Код
ActiveWindow.SelectedSheets.PrintOut From:=2, To:=KolStran-1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
Дело в том, что имя книги и листа все время меняется
Именно поэтому я и написал ActiveWorkbook и ActiveSheet

Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
Нашел на просторах счетчик
Это же одно и то же, Вы разве не видите?

Цитата maksimolololllka, 17.01.2023 в 15:36, в сообщении № 6 ()
как его грамотно интегрировать в код при печати страниц в конце кода со второй до предпоследней?
А Вы как делаете-то?
[vba]
Код
ActiveWindow.SelectedSheets.PrintOut From:=2, To:=KolStran-1, Copies:=1, Collate _
        :=True, IgnorePrintAreas:=False
[/vba]

Автор - _Boroda_
Дата добавления - 17.01.2023 в 15:43
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор последней и предпоследней страницы при печати (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2023 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!