regarding TOC mutiple pages no of a work book

[rathandeep]

hi i have been reading your mails am finding them very useful. thanks for this.well i have a small issue- am using macros & not having any idea of vb.

1. i need to create a good table of contents for my excel sheet.& i have foundthe following vb code in the net.

'Sub CreateTableOfContents()

' Copyright 2002 MrExcel.com

' Determine if there is already a Table of Contents

' Assume it is there, and if it is not, it will raise an error

' if the Err system variable is > 0, you know the sheet is not there

Dim WST As Worksheet

On Error Resume Next

Set WST = Worksheets("Table of Contents")

If Not Err = 0 Then

' The Table of contents doesn't exist. Add it

Set WST = Worksheets.Add(Before:=Worksheets(1))

WST.Name = "TOC"

End If

On Error GoTo 0


' Set up the table of contents page

WST.[A2] = "Table of Contents"

With WST.[A6]

.CurrentRegion.Clear

.Value = "Subject"

End With

WST.[B6] = "Page(s)"

WST.Range("A1:B1").ColumnWidth = Array(36, 12)

TOCRow = 7

PageCount = 0

' Do a print preview on all sheets so Excel calcs page breaks

' The user must manually close the PrintPreview window

Msg = "Excel needs to do a print preview to calculate the number of pages. "

Msg = Msg & "Please dismiss the print preview by clicking close."

MsgBox Msg

ActiveWindow.SelectedSheets.PrintPreview

' Loop through each sheet, collecting TOC information

' Loop through each sheet, collecting TOC information

For Each S In Worksheets

If S.Visible = -1 Then

S.Select

' Use any one of the following 3 lines

ThisName = ActiveSheet.Name

'ThisName = Range("A1").Value

'ThisName = ActiveSheet.PageSetup.LeftHeader

HPages = ActiveSheet.HPageBreaks.Count + 1

VPages = ActiveSheet.VPageBreaks.Count + 1

ThisPages = HPages * VPages

' Enter info about this sheet on TOC

Sheets("TOC").Select

Range("A" & TOCRow).Value = ThisName

Range("B" & TOCRow).NumberFormat = "@"

If ThisPages = 1 Then

Range("B" & TOCRow).Value = PageCount + 1 & " "

Else

Range("B" & TOCRow).Value = PageCount + 1 & " - " & PageCount + ThisPages

End If

PageCount = PageCount + ThisPages

TOCRow = TOCRow + 1

End If

Next S

End Sub

this code generate a decent TOC , but the issue is the TOC is not presentable & i want to format this sheet & hence create a macro for formatting- inserting a row above a specified row, highliting a row , inserting a heading for a set of sheets etc.

please help me to format this sheet.


another issue is now that i have created a TOC , when i take printout of the work book the page numbers are not appearing as per the order of TOC . how to do this?


i found something on the net. its given below , but am not able to interpret it. please help me on this.

Multiple Page Numbers

I was in someone's office and found they had a workbook with about 40 linked sheets. They were jumping through hoops trying to print the sheets with page numbers as though they were all on the same sheet. Here is a quicky to make the nice page numbering AND print the whole document in one swoop.

The line for “Second” is the only thing to change as sheets are added or removed. Makes pretty footers with “Page 2 of 15”, etc..

'Option Explicit

Sub PrintBigBook()

Dim First As Integer, Second As Integer

Sheets("Sheet1").Activate

Second = 4 'CHANGE THIS NUMBER WHEN YOU ADD WORKSHEETS

For First = 1 To Second


With ActiveSheet.PageSetup

.PrintTitleRows = ""

.PrintTitleColumns = ""

End With

ActiveSheet.PageSetup.PrintArea = ""

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = "&F!&A"

.RightHeader = ""

.LeftFooter = ""

.CenterFooter = "Page " & First & " of " & Second

.RightFooter = "©" & Application.Text(Now(),"yyyy")

.PrintHeadings = False

.PrintGridlines = False

.PrintNotes = False

.PrintQuality = 360

.CenterHorizontally = True

.CenterVertically = False

.Orientation = xlPortrait

.Draft = False

.PaperSize = xlPaperLetter

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = False

.FitToPagesWide = 1

.FitToPagesTall = 1

End With

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ActiveSheet.Next.Select

Next First

'If you have special pages, include code for them here.

End Sub

if i run this it is showing error. & as an amateur am not able to fix it.

thank phd for patient reading.

 

[Hui]

Rathandeep


re: The second Macro Sub PrintBigBook()


There may be 2 or more issues here


1. Check that your printer supports the page size and quality you have specified

ie: .PrintQuality = 360 doesn't work for me but 300 does.

Goto Page Setup and check the Print Quality pulldown


2. Change the last few lines as follows


ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True


If First < Second Then

Application.ActiveSheet.Next.Select

End If

Next First


'If you have special pages, include code for them here.

End Sub

 

[Hui]

Rathandeep

Re The first TOC Macro


The best way to learn VBA is to use the Macro Recorder.


Run the TOC Macro and make your TOC


So start the Macro Recorder

Next Go through the steps to format your TOC as you wish

Stop Recording the Macro when Finished

Don't worry about making mistakes, its a Macro and you can edit them out.


If you can't follow what the Macro Recorder makes for you try doing 1 or 2 steps at a time and then review the Macro.

This way you can add the good steps to a Master Macro and delete the bits you don't want as you go.


Once you have a basic outline of your macro, you can start to add variables and loops to automate and repeat functions


Once you have your formatting macro working you can add it or call it from the end of the TOC Macro so that it happens every time you make a new TOC


Last suggestion is always save a good copy somewhere else before you start, macros can destroy spreadsheet contents as easily as assist them


Good Luck

 

[rathandeep]

hi hui

thanks , i shall check it now as per ur instruction for the 2nd macro.it is a very nice suggestion on how to operate with macro . this shall also be implemented.

thank u