PDA

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