Click to See Complete Forum and Search --> : Help needed in Excel
cssriraman
Apr 17th, 2006, 02:44 PM
Hi,
I have a number of excel sheets that are not formatted and vary in the
number of pages.
I would like to have them landscaped and have a page break inserted after
the “Page” number.
The first page does not contain a “Page” number.
Could you please provide me with a working sample of code to accomplish
this task.
Thank you in advance.
Bruce Fox
Apr 17th, 2006, 09:44 PM
Option Explicit
Private Sub Whatever()
Dim shtSheet As Worksheet
For Each shtSheet In Worksheets
'Part A:
shtSheet.PageSetup.Orientation = xlLandscape
'Part B:
If shtSheet.Index <> 1 Then shtSheet.Rows(25).PageBreak = xlPageBreakManual
Next
End Sub
I had a guess where the "Page Number" may be.... (Eg row 25) You can tweek as required. :)
cssriraman
Apr 23rd, 2006, 07:50 PM
Here is the sample file uploaded. Please help.
DKenny
May 23rd, 2006, 01:15 PM
Cssriraman
I think I've got what you need. Rather than using the page number as the identifier, I used the title of the next page "ABC QUOTING CENTER" " as the placeholder to determine where to insert the page breaks. Here's the procedure that adds the breaks and a sample proc showing how its used.
Let me know if this works.
Option Explicit
Sub FormatReport(SheetName As String, TitleColumn As Long)
Dim wksSheet As Worksheet
Dim rngSearch As Range
Dim lRowCount As Long
Dim lRowNum As Long
On Error Resume Next
Set wksSheet = ThisWorkbook.Worksheets(SheetName)
On Error GoTo 0
'Trap for cases where the sheet nmae doesn't exist
If wksSheet Is Nothing Then Exit Sub
With wksSheet
'Remove current breaks
.ResetAllPageBreaks
With .PageSetup
'Set page as landscape and 1 page wide
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
'Column where we search for the page title
Set rngSearch = .Columns(TitleColumn)
'Number of rows to check for page headers
lRowCount = .UsedRange.Rows.Count
End With
'Ingnore the first page by starting at row 3
For lRowNum = 3 To lRowCount
With rngSearch.Cells(lRowNum, 1)
'When the title exist in the row...
If .Value = "ABC QUOTING CENTER " Then
'...insert a break one row up
.Offset(-1, 0).PageBreak = xlPageBreakManual
End If
End With
Next lRowNum
'Clear Object Variables
Set wksSheet = Nothing
End Sub
'Here's the code in action
Sub sample()
FormatReport "Close Ratio by Customer", 8
FormatReport "Quotation Activity", 11
End Sub
vbforums.com
Copyright Internet.com Inc., All Rights Reserved.