Need Macro to Print Current Page Only (2)

[Don Lowe]

I have many people using the file. Each person only needs a page worth of
information. I need a Macro to print curent page only.

I am hoping to have a macro that looks at what pape I am on and will print
the specific page. This way I do not need to make 97 buttons for printing.
One button printing where ever you are (most of my users would not now where
they are and I am trying to make this really really easy for them).

The following code is what one person gave me. I just can't get it to work.
Please help!!!

Function PageInfo(currCell As Range)
Dim iPages As Integer
Dim iCol As Integer
Dim iCols As Integer
Dim lRows As Long
Dim lRow As Long
Dim x As Long
Dim y As Long
Dim hBreaks As Long
Dim vBreaks As Long
Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview
hBreaks = Worksheets(1).HPageBreaks.Count
vBreaks = Worksheets(1).VPageBreaks.Count
iPages = (hBreaks + 1) * (vBreaks + 1)
With ActiveSheet
y = currCell.Column
iCols = .VPageBreaks.Count
x = 0
Do
x = x + 1
Loop Until x = iCols _
Or y < .VPageBreaks(x).Location.Column
iCol = x
If y >= .VPageBreaks(x).Location.Column Then
iCol = iCol + 1
End If
y = ActiveCell.Row
lRows = .HPageBreaks.Count
x = 0
Do
x = x + 1
Loop Until x = lRows _
Or y < .HPageBreaks(x).Location.Row
lRow = x
If y >= .HPageBreaks(x).Location.Row Then
lRow = lRow + 1
End If
If .PageSetup.Order = xlDownThenOver Then
PageInfo = (iCol - 1) * (lRows + 1) + lRow
Else
PageInfo = (lRow - 1) * (iCols + 1) + iCol
End If
End With
Application.ScreenUpdating = True
ActiveWindow.View = xlNormalView
End Function

Sub printpage()
Dim p As Long
p = PageInfo(ActiveCell)
ActiveSheet.PrintOut From:=p, To:=p
End Sub

 

[Don Guillett]

Sub printactivepage()
ActiveSheet.Printout 'Preview
End Sub

 

[Don Lowe]

Don,

I tried you code. and it printed out the whole file. What would I do to just
print the current page?

 

[Don Guillett]

A file is a workbook
A sheet is a tab (page) of a workbook.

The code I sent will print the current sheet ONLY, not the WORKBOOK (file).
Do you mean you want to print part of the sheet? If so, more detail.

 

[Don Lowe]

Don,

I see what you are saying. If I print a tab or sheet I end up printing about
100 pages. I am wanting to print one page (current page) only. So yes, I only
want to print part of a sheet. Each sheet has information for 9 supervisors
broken down into weeks (5 weeks per supervisor). When printing the supervisor
does not know what pages they need to print out. I want to make it easy for
them by having a button that when pushed will print the specific page that
the supervisor is currently working on (instead of all one 100).

 

[Don Guillett]

I assume that each row identifies a supervisor by name or number. Can you
filter and print visible cells?
If all else fails, send your workbook to the address below and I will take a
look

 

[Don Guillett]

Something like this assigned to a shape or forms button or even a
double_click event where the supervisor is identified in col B and you
select any cell of that supervisor and fire the macro

Sub printactivesupervisor()
who = ActiveCell.Value
lr = Cells(Rows.Count, "a").End(xlUp).Row
Range("a1:x" & lr).AutoFilter field:=2, Criteria1:=who
Rows("1:" & lr).PrintPreview
Range("a1:d" & lr).AutoFilter
End Sub

Right click sheet tab>view code>insert this>double click on supervisor name
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
who = Target.Value
lr = Cells(Rows.Count, "a").End(xlUp).Row
Range("a1:d" & lr).AutoFilter field:=2, Criteria1:=who
Rows("1:" & lr).PrintPreview
Range("a1:d" & lr).AutoFilter
End Sub

 

[Don Guillett]

Private email sent with this

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target
As Range, Cancel As Boolean)
If Application.Trim(ActiveCell) <> "Week Ending:" Then Exit Sub
ar = Target.Row
ac = Target.Column
plr = Cells.Find(What:="Notes", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Row
Range(Cells(ar - 2, ac - 23), Cells(plr, ac + 6)).PrintPreview
ActiveCell.Offset(, -1).Select
End Sub