Many have tried, but no one has succeded
Posted by Mike P (UK) on February 02, 2002 4:08 AM
It seems simple but it isn't. I have a fairly long spreadsheet I am trying to write a Macro that will travel down column 'A' select a cell (containing the current date) then set the print area FROM that cell for one page only.
Any help would be much appreciated.
Mike P (UK)
PS
Mike H thanks for your suggestion, it selects the right cell but will not set the one page print area
Posted by Juan Pablo G. on February 02, 2002 8:57 AM
What paper are you using ? how many lines can you print using this paper ? landscape or portrait ?
Setting ONE page is difficuly, especially because it depends on printer drivers, so, if you're gonna use this FOR yourself, it wouldn't be THAT hard, but if you need it to be "generic", well, that's a little harder...
Juan Pablo G.
Posted by Gary Bailey on February 03, 2002 10:04 AM
Try this code
Sub PrintAreaOnePage()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim x As Integer, y As Integer
With ActiveSheet.PageSetup
' find number of columns
Do
x = x + 1
.PrintArea = ActiveCell.Resize(1, x).Address
Loop Until ActiveSheet.VPageBreaks.Count = 1
x = x - 1
Do
y = y + 1
.PrintArea = ActiveCell.Resize(y, 1).Address
Loop Until ActiveSheet.HPageBreaks.Count = 1
y = y - 1
.PrintArea = ActiveCell.Resize(y, x).Address
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Gary
Posted by Proteus on February 04, 2002 1:47 AM
A slightly faster alternative (no loop) ......
Sub PrintAreaOnePage()
Dim rw%, col%
ActiveSheet.PageSetup.PrintArea = ActiveCell.Address & ":IV65536"
rw = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," & 2 & ")") - 1
col = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(65)," & 2 & ")") - 1
ActiveSheet.PageSetup.PrintArea = ActiveCell.Address & ":" & Cells(rw, col).Address
End Sub
Dim x As Integer, y As Integer With ActiveSheet.PageSetup ' find number of columns Do x = x + 1 .PrintArea = ActiveCell.Resize(1, x).Address Loop Until ActiveSheet.VPageBreaks.Count = 1 x = x - 1 Do y = y + 1 .PrintArea = ActiveCell.Resize(y, 1).Address Loop Until ActiveSheet.HPageBreaks.Count = 1 y = y - 1 End With Application.DisplayAlerts = True Application.ScreenUpdating = True
Posted by Proteus on February 04, 2002 3:36 AM
Doesn't work. Needs revising. Later ... (nt)
Dim x As Integer, y As Integer With ActiveSheet.PageSetup ' find number of columns Do x = x + 1 .PrintArea = ActiveCell.Resize(1, x).Address Loop Until ActiveSheet.VPageBreaks.Count = 1 x = x - 1 Do y = y + 1 .PrintArea = ActiveCell.Resize(y, 1).Address Loop Until ActiveSheet.HPageBreaks.Count = 1 y = y - 1 End With Application.DisplayAlerts = True Application.ScreenUpdating = True
Posted by Proteus on February 04, 2002 4:49 AM
Revised .....
Sub PrintAreaOnePage()
Dim rw%, col%, x#, y%
If Intersect(ActiveCell, ActiveSheet.UsedRange) Is Nothing Then
MsgBox "The activecell is not within the sheet's used range"
Exit Sub
End If
ActiveSheet.PageSetup.PrintArea = ""
x = ActiveCell.Row
y = ActiveCell.Column
On Error Resume Next
rw = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64)," & 1 & ")") + x - 2
If rw = 0 Then
rw = Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
End If
col = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(65)," & 1 & ")") + y - 2
If col = 0 Then
col = Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
End If
On Error GoTo 0
ActiveSheet.PageSetup.PrintArea = ActiveCell.Address & ":" & Cells(rw, col).Address
End Sub
Dim x As Integer, y As Integer With ActiveSheet.PageSetup ' find number of columns Do x = x + 1 .PrintArea = ActiveCell.Resize(1, x).Address Loop Until ActiveSheet.VPageBreaks.Count = 1 x = x - 1 Do y = y + 1 .PrintArea = ActiveCell.Resize(y, 1).Address Loop Until ActiveSheet.HPageBreaks.Count = 1 y = y - 1
