Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Печать


Rambler's Top100


Counter CO.KZ

  1. Как распечатать все диаграммы в нужном рабочем листе ? 12.12.2006
  2. Как узнать сколько печатных страниц в активном листе ? 2004
  3. Как перед печатью или просмотром выводить диалоговое окно с подтвержением или отменой печати ? 08.10.2006
  4. Как сделать так, чтобы во время печати, на экране не отображалось стандартное диалоговое окно "Печать" ? 23.12.2007
  5. Как распечатать ячейки и графику нужного диапазона ? 10.10.2010
  6. Как распечатать лист, несколько нужных листов (без цикла) и рабочую книгу ? NEW 09.07.2016
  7. Как перед печатью/просмотром "сгенерировать" колонтитул содержащий данные нужных ячеек и отменить печать, если данные не соответствуют нужному типу ? 23.02.2007
  8. Как перед печатью/просмотром добавить в нижний колонтитул нумерацию страниц, имя листа, а также полное имя файла(путь+имя) ? 10.05.2007
  9. Как перед печатью/просмотром добавить в нижний колонтитул автора, автора изменений, а также время последней печати ? 21.05.2007
  10. Как перед печатью/просмотром добавить в нижний колонтитул имя пользователя ? NEW 10.07.2016
  11. Как перед печатью/просмотром скрыть все столбцы, которые не содержат данных для печати ? 21.05.2007
  12. Как перед печатью/просмотром скрыть данные определённых ячеек ? 11.11.2010
  13. Как автоматически менять диапазон для печати/просмотра в зависимости от активной ячейки ? NEW 17.09.2016
  14. Как запретить печать/просмотр определённого рабочего листа, если в любой из его ячеек, будет находиться (в т.ч. и частично) ненужный текст ? NEW 08.07.2016
  15. Как запретить печать/просмотр всех листов, кроме одного, необходимого ? 02.05.2007
  16. Как разрешить печать/просмотр только нужных листов ? 02.05.2007
  17. Как выполнить нужный макрос только перед печатью листа ? 16.06.2007
  18. Как распечатать данные на определённом принтере ? 28.10.2010
  19. Как узнать дату и время последней печати/просмотра ? 07.03.2011
  20. Как найти пустой колонтитул или заполненный данными, отличными от стандартных ? NEW 10.07.2016

  • Ответ :
  • ThisWorkbook.Worksheets(1).Range("B2:C10").PrintOut
    Предполагается, что распечатать нужно только ячейки и графические об'екты диапазона B2:C10 первого рабочего листа текущей рабочей книги.

    Примечание : Обратите внимание на то, что если графический об'ект будет, что называется, выходить за рамки указанного диапазона, то он всё равно будет распечатан полностью. Если же Вы не хотите печать графику, то используйте любой из двух нижеопубликованных вариантов :
    With ThisWorkbook
         .DisplayDrawingObjects = xlHide
         .Worksheets(1).Range("B2:C10").PrintOut
         .DisplayDrawingObjects = xlAll 'xlPlaceholders
    End With
    With ThisWorkbook.Worksheets(1)
         .DrawingObjects.PrintObject = False
         .Range("B2:C10").PrintOut
         .DrawingObjects.PrintObject = True
    End With
    With ThisWorkbook.Worksheets(1).DrawingObjects
         .PrintObject = False
         .Parent.Range("B2:C10").PrintOut
         .PrintObject = True
    End With

  • Ответ :

    Печать первого рабочего листа текущей рабочей книги :
  • ThisWorkbook.Worksheets(1).PrintOut
    Печать рабочего листа с именем "Таблица" :
    ThisWorkbook.Worksheets("Таблица").PrintOut
    Печать листа диаграммы с именем "Диаграмма" :
    ThisWorkbook.Sheets("Диаграмма").PrintOut
    'ThisWorkbook.Charts("Диаграмма").PrintOut
    Печать первого и третьего рабочего листа :
    ThisWorkbook.Worksheets(Array(1, 3)).PrintOut
    Печать листов с именами "Диаграмма" и "Таблица" :
    ThisWorkbook.Sheets(Array("Диаграмма", "Таблица")).PrintOut
    Печать всей текущей книги :
    ThisWorkbook.PrintOut

  • Ответ : Актуально для MS Excel 97, 2000, XP Скачать пример

    Разместите в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If TypeOf Me.ActiveSheet Is Worksheet Then
           With Me.ActiveSheet
                If Application.IsText(.Range("B2")) = True And _
                   Application.IsNumber(.Range("B3")) = True Then
                   .PageSetup.RightFooter = _
                   "Внутренний курс компании " & .Range("B2") & _
                   " составляет " & .Range("B3") & " руб."
                Else
                   Cancel = True
                End If
           End With
        End If
    End Sub
    Предполагается, что :
  • Ячейка B2 содержит название компании (текст)
  • Ячейка B3 содержит внутренний курс компании (число)
  • Страница не должна выводиться на печать/просмотр, если ячейка B2 не будет содержать текста и/или ячейка B3 не будет содержать числа.

    Примечание :
  • Если необходимо создать колонтитул только для определённого рабочего листа, то вместо ActiveSheet используйте имя, кодовое имя или индекс нужного листа.
  • Если необходимо выводить строго определённое количество цифр после запятой, то воспользуйтесь стандартными функциями рабочего листа типа ОКРУГЛВВЕРХ/RoundUp или функцией Basic - Format.
  • Ответ : Актуально для MS Excel 97, 2000

    Разместите в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Application.ScreenUpdating = False
        With Me.ActiveSheet.PageSetup
             .LeftFooter = "&B Страница &P"
             .CenterFooter = "&B &A"
             .RightFooter = "&B" & Me.FullName
        End With
        Application.ScreenUpdating = True
    End Sub
    Примечание : Изменение начертания шрифта (полужирный) &B используется лишь для демонстрации дополнительных возможностей и не носит обязательного характера.

    Актуально для MS Excel XP
    В этой версии, добавить в колонтитул полное имя файла или путь, можно без применения макросов. Более полную информацию можно получить здесь.
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Разместите в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Me.ActiveSheet.PageSetup.LeftFooter = _
        "Автор : " & Me.BuiltinDocumentProperties("Author") & vbCrLf & _
        "Автор изменений : " & Me.BuiltinDocumentProperties("Last Author") & vbCrLf & _
        "Время предыдущей печати : " & Me.BuiltinDocumentProperties("Last Print Date")
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        With Me.BuiltinDocumentProperties
             Me.ActiveSheet.PageSetup.LeftFooter = _
             "Автор : " & .Item("Author") & vbCr & _
             "Автор изменений : " & .Item("Last Author") & vbCr & _
             "Время предыдущей печати : " & .Item("Last Print Date")
        End With
    End Sub

  • Ответ : Актуально для MS Excel 97-2003

    Если перед печать/просмотром Вам необходимо вывести в колонтитуле имя пользователя Excel или имя текущего пользователя, то разместите весь нижеопубликованный код в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Me.ActiveSheet.PageSetup.LeftFooter = Application.UserName 'Environ("UserName")
    End Sub
    Примечание : Вывод информации в нижнем колонтитуле слева не является обязательным условием, проще говоря, Вы можете использовать любой из 2x3 частей колонтитулов.
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Разместите в модуле ThisWorkbook(ЭтаКнига) :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If Not TypeOf Me.ActiveSheet Is Worksheet Then Exit Sub
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        With Me.ActiveSheet: Cancel = True
             iPrint$ = .PageSetup.PrintArea
             iAddress$ = IIf(iPrint$ = "", .UsedRange.Address, iPrint$)
             Dim iColumn As Range
             For Each iColumn In .Range(iAddress$).Columns
                 If Application.CountBlank(iColumn) = _
                 iColumn.Rows.Count Then iColumn.EntireColumn.Hidden = True
             Next
             .PrintOut 'Copies:=3 'кол-во копий
             .Range(iAddress$).EntireColumn.Hidden = False
        End With
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End Sub
    Примечание : В этом примере, столбцы, которые не содержат данных для печати, после просмотра/печати снова отображаются. Если эти столбцы уже были скрыты и отображать их не нужно, то первоначальный код необходимо немного изменить.
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы перед печатью/просмотром скрыть данные определённых ячеек, в данном примере это ячейки диапазона "Имя_диапазона" рабочего листа с именем "Итоги", скопируйте в модуль ThisWorkbook(ЭтаКнига) следующий код :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If Me.ActiveSheet.Name = "Итоги" _
        Then Cancel = True Else Exit Sub

        Application.ScreenUpdating = False
        Application.EnableEvents = False '

        Dim iArchive As New Collection
        Dim iSource As Range, iCell As Range
        Set iSource = Me.ActiveSheet.Range("Имя_диапазона")
        For Each iCell In iSource
            With iCell
                 iArchive.Add .Font.Color, .Address
                 .Font.Color = .Interior.Color
            End With
        Next
        Me.ActiveSheet.PrintOut 'Copies:=3 'кол-во копий
        For Each iCell In iSource
            iCell.Font.Color = iArchive(iCell.Address)
        Next

        Application.EnableEvents = True '
        Application.ScreenUpdating = True
    End Sub
    Примечание : Данный пример не предназначен для применения, если в любой из ячеек, не предназначенных для печати, используется шрифт разного цвета. Впрочем, "разноцветные" (и не только) ячейки можно скрыть с помощью немного дополненного первого (скачать здесь) или второго варианта (см.далее), однако он не позволит скрыть значения ошибок (разумеется, если таковые присутствуют)
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If Me.ActiveSheet.Name = "Итоги" _
        Then Cancel = True Else Exit Sub

        Application.ScreenUpdating = False
        Application.EnableEvents = False '

        Dim iArchive As New Collection
        Dim iSource As Range, iCell As Range
        Set iSource = Me.ActiveSheet.Range("Имя_диапазона")
        For Each iCell In iSource
            iArchive.Add iCell.NumberFormat, iCell.Address
        Next
        iSource.NumberFormat = ";;;"
        Me.ActiveSheet.PrintOut 'Copies:=2 'кол-во экз.
        For Each iCell In iSource
            iCell.NumberFormat = iArchive(iCell.Address)
        Next

        Application.EnableEvents = True '
        Application.ScreenUpdating = True
    End Sub
    Комментарий : Присвоение диапазону ячеек - имени, в данном примере, это "Имя_диапазона", не является обязательным условием, т.е. Вы можете перечислить все ячейки, данные которых не нужно выводить на печать/просмотр (в т.ч. и несмежные), непосредственно в коде, например : Me.ActiveSheet.[A10,F10,B11:D11]
  • Ответ : Актуально для MS Excel 97-2003

    Для того, чтобы запретить печать/просмотр конкретного рабочего листа, если в любой из его ячеек будет найден определённый текст, скопируйте в модуль ThisWorkbook(ЭтаКнига) любой из вариантов, разумеется, указав свой лист и запретный текст.
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If LCase(Me.ActiveSheet.Name) <> "проект" Then Exit Sub
        Cancel = Application.CountIf(Me.ActiveSheet.UsedRange, "*не подписан*")
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If LCase(Me.ActiveSheet.Name) <> "проект" Then Exit Sub
        Cancel = Not Me.ActiveSheet.UsedRange.Find("не подписан", , xlValues, xlPart) Is Nothing
    End Sub
    Если же Вы предпочитаете более наглядный вариант, где пользователь также сможет увидеть соответствующее сообщение, то :
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If LCase(Me.ActiveSheet.Name) = "проект" Then
           If Not Me.ActiveSheet.UsedRange.Find("не подписан", , xlValues, xlPart) Is Nothing Then
              Cancel = True
              MsgBox "Печать/просмотр невозможен", vbCritical, ""
           End If
        End If
    End Sub
    Предполагается, что : "проект" это имя рабочего листа, а "не подписан", это текст, при наличии которого, необходимо запретить печать. Обратите внимание на то, что регистр символов здесь не важен, т.е. Вы можете присвоить нужному листу имя : "Проект", "ПРОЕКТ" и т.п. , тоже самое касается и текста.

    Примечание : Если существует вероятность случайного переименования листа, то Вы можете воспользоваться этим советом, или же использовать CodeName кодовое(программное) имя листа. Только имейте ввиду, что этого свойства нет у листов диалога(диалоговых листов)
  • Ответ : Актуально для MS Excel 97-2003

    Если необходимо автоматически менять диапазон для печати/просмотра, в зависимости от активной ячейки. Т.е. если активной является любая из ячеек диапазона "A1:M8", то выводить на печать/просмотр диапазон "A1:M8", если активная ячейка является частью диапазона "A9:M10", то, соответственно, диапазон "A9:M10" и т.д. А если активная ячейка не попадает ни в один из перечисленных в событии диапазонов, то просто запретить печать/просмотр, то скопируйте в модуль ThisWorkbook(ЭтаКнига) следующий код, разумеется, перечислив адреса или имена своих диапазонов.
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        For Each iAddress In Array("A1:M8", "A9:M10", "Q1:S100")
            If Not Intersect(ActiveCell, Range(iAddress)) Is Nothing Then
               Me.ActiveSheet.PageSetup.PrintArea = iAddress: Exit Sub
            End If
        Next
        Cancel = True
    End Sub
    Если же рабочая книга, где предполагается, таким образом, автоматизировать вывод диапазонов на печать/просмотр, содержит более одного листа. А выполнять такую автоматизацию необходимо только для конкретного рабочего листа, то используйте следующий вариант, где "прайс" это имя Вашего рабочего листа. Обратите внимание на то, что регистр символов здесь не важен, т.е. Вы можете присвоить нужному листу имя : "Прайс", "ПРАЙС" и т.п., однако в макросе все буквы этого имени должно быть строчными(нижний регистр)
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        If LCase(Me.ActiveSheet.Name) <> "прайс" Then Exit Sub
        For Each iAddress In Array("A1:M8", "A9:M10", "Q1:S100")
            If Not Intersect(ActiveCell, Range(iAddress)) Is Nothing Then
               Me.ActiveSheet.PageSetup.PrintArea = iAddress: Exit Sub
            End If
        Next
        Cancel = True
    End Sub
    Примечание : Если существует вероятность случайного переименования листа, то Вы можете воспользоваться этим советом, или же использовать CodeName кодовое(программное) имя листа. Только имейте ввиду, что этого свойства нет у листов диалога(диалоговых листов)
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Разместите в модуле ThisWorkbook(ЭтаКнига) любой из подвариантов :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = StrComp(Me.ActiveSheet.Name, "Отчёт", vbTextCompare)
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = CBool(StrComp(Me.ActiveSheet.Name, "Отчёт", vbTextCompare))
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = (StrComp(Me.ActiveSheet.Name, "Отчёт", vbTextCompare) <> 0)
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = LCase(Me.ActiveSheet.Name) = "отчёт"
    End Sub
    Предполагается, что : "Отчёт" это имя листа (не обязательно рабочего) который разрешается выводиться на печать/просмотр. Обратите внимание на то, что регистр символов здесь не важен, т.е. Вы можете присвоить нужному листу имя : "ОТЧЁТ", "ОтчёТ" и т.п.

    Примечание : Если существует вероятность случайного переименования/перемещения листа, то Вы можете воспользоваться этим советом, или же использовать CodeName кодовое(программное) имя листа. Только имейте ввиду, что этого свойства нет у листов диалога(диалоговых листов)
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Разместите в модуле ThisWorkbook(ЭтаКнига) любой из трёх вариантов :
  • Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = IsError(Application.Match( _
        Me.ActiveSheet.Name, Array("Отчёт", "График", "Продажи"), 0))
    End Sub
    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Select Case LCase(Me.ActiveSheet.Name)
            Case "отчёт", "график", "продажи"
            Case Else: Cancel = True
        End Select
    End Sub
    Option Compare Text

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        For Each iShName In Array("Отчёт", "График", "Продажи")
            If Me.ActiveSheet.Name Like iShName Then Exit Sub
        Next
        Cancel = True
    End Sub
    Предполагается, что : "Отчёт", "График", "Продажи" это имена листов (причём не обязательно рабочих) которые разрешается выводиться на печать/просмотр. Обратите внимание на то, что регистр символов здесь не важен (см. предыдущий вопрос)

    Примечание : Смотрите выше
  • Ответ : Актуально для MS Excel 97, 2000, XP Скачать пример

    Как известно, событие рабочей книги Workbook_BeforePrint() выполняется не только перед печатью, но и перед просмотром листа. Для того, чтобы этого избежать, достаточно разместить в модуле ThisWorkbook(ЭтаКнига) нужной рабочей книги, следующий код :
  • Private Sub Workbook_Activate()
        Dim iCommandBar As CommandBar
        Dim iFindControl As CommandBarButton

        iProcedure$ = Me.CodeName & ".Workbook_SheetPreview"

        For Each iCommandBar In Application.CommandBars
            Set iFindControl = iCommandBar.FindControl _
            (Id:=109, Visible:=False, Recursive:=True)
            If Not iFindControl Is Nothing Then _
               iFindControl.OnAction = iProcedure$
        Next
    End Sub

    Private Sub Workbook_Deactivate()
        Dim iCommandBar As CommandBar
        Dim iFindControl As CommandBarButton

        For Each iCommandBar In Application.CommandBars
            Set iFindControl = iCommandBar.FindControl _
            (Id:=109, Visible:=False, Recursive:=True)
            If Not iFindControl Is Nothing Then _
               iFindControl.Reset
        Next
    End Sub

    Private Sub Workbook_BeforePrint(Cancel As Boolean)
        Cancel = True
        With Application
             .EnableEvents = False
             'Здесь Вы можете выполнить нужные действия
             .Dialogs(xlDialogPrint).Show Arg4:=3, Arg12:=1
             .EnableEvents = True
        End With
    End Sub

    Private Sub Workbook_SheetPreview()
        With Application
             .EnableEvents = False
             .ActiveSheet.PrintPreview
             .EnableEvents = True
        End With
    End Sub

  • Ответ :

    Для того, чтобы распечатать данные на нужном принтере, т.е. на принтере не используемым по умолчанию, можно воспользоваться необязательным аргументом ActivePrinter метода PrintOut
  • ActiveSheet.PrintOut ActivePrinter:="HP LaserJet 5L"
    Range("A1:C10").PrintOut ActivePrinter:="HP LaserJet 5L (LPT1:)"
    Обратите внимание на то, что имя и порт принтера использованы исключительно в качестве примера и подлежат замене на реально существующие.
  • Ответ :

    Для того, чтобы определить когда в определённой рабочей книге в последний раз была осуществлена печать (или просмотр), можно воспользоваться соответствующим свойством книги, а именно "Last Print Date"
  • iPrintDate = Workbooks(1).BuiltinDocumentProperties("Last Print Date")
    iPrintDate = ThisWorkbook.BuiltinDocumentProperties("Last Print Date")
    iPrintDate = ActiveWorkbook.BuiltinDocumentProperties("Last Print Date")
    Примечание : Если в рабочей книге никогда не применялась печать/просмотр, то попытка получить значение свойства "Last Print Date" приведёт к возникновению ошибки.
  • Ответ : Актуально для MS Excel 2000(и старше)

    Для того, чтобы с помощью VBA, вывести информацию в нужной части колонтитула, можно использовать любую из 2x3 частей, а именно :
  • LeftFooter   | Слева    (нижний колонтитул)
    CenterFooter | В центре (нижний)
    RightFooter  | Справа   (нижний)
    LeftHeader   | Слева    (верхний колонтитул)
    CenterHeader | В центре (верхний)
    RightHeader  | Справа   (верхний)
    Но если существует вероятность, что в процессе работы с книгой, кто-то воспользуется выбранным Вами колонтитулом, то Ваш макрос просто удалит чужие данные. Чтобы этого не происходило, можно найти или первую пустую (не заполненную) часть колонтитула или заполненную, но данными, отличными от стандартных.
    Private Sub CreateNewTitle() 'Micosoft Excel 2000
        Dim iText$, iTitle As Variant
        iText = "Новый текст для колонтитула"

        For Each iTitle In Array("LeftFooter", "CenterFooter", _
            "RightFooter", "LeftHeader", "CenterHeader", "RightHeader")
            If Not CallByName(ActiveSheet.PageSetup, iTitle, VbGet) Like "*&[A-Z]*" Then
               CallByName ActiveSheet.PageSetup, iTitle, VbLet, iText
               Exit Sub
            End If
        Next

        MsgBox "Увы, все части колонтитулов заняты", vbCritical, ""
    End Sub


    Вопросы - Синонимы
  • Как программно распечатать только часть таблицы ?


  • Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff