Предполагается, что распечатать нужно только ячейки и графические
об'екты диапазона 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 |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Вопросы - Синонимы
Воспроизведение любых опубликованных здесь материалов возможно только с
письменного разрешения автора :