rathandeep
New Member
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.
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.