Generating Table of Contents (Excel XP)

[gerbenhk]

I want to automatically generate a Table of Contents (or index). When I run this macro I want to list all the sheets (except one named "Berekening") with the pagenumbers in a TOC. The pagenumbers are located in the footer of each sheet.

Can anyone help me with this?

Gerben

[sdckapr]

Are these page numbers you have EXPLICITLY added to the footer (independent of what you have selected to print) or does excel generate them "automatically" when you print?

If the latter, what is selected when you print?

Where do you want the "TOC" on a particular sheet , what range, on a newly created sheet?

Steve

[gerbenhk]

Steve,

I've added the Pagina &[Pagina] to the footer of all sheets. (Page = Pagina in Dutch). So when I select al sheets, and I print them the page numbers are generated automatically.

I want to generate the TOC automatically because I sometimes remove some sheets from my workbook.
I want the TOC on an existing sheet, it's a dedicated sheet for the TOC

tnx

Gerben

[sdckapr]

Now when you say "Select all sheets" I assume you mean ALL But "Berekening". Is TOC also selected or should it be ignored?
If is is selected, do you want the TOC sheet to be listed in the TOC and have a page number or should it be ignored/removed?

What sheetname for the TOC and what cells should hold the TOC? Arre you going to manually do the formatting or do you want the macro to do it? Any special info or titles? or just a list (in eg Col A giving the sheet name and in col B giving the page it starts or perhaps the range of pages?)

The TOC will NOT be "Live" it will have to be generated whenever you want to update it (perhaps call the routine in the beforeprint event). It will involve selecting all the appropriate sheets, going through this selection sheet by sheet and counting how many pages it will take to print and then transferring that info to the TOC sheet.

Steve

[gerbenhk]

Steve,

It's indeed all sheets except "Berekening" AND the first sheet (named: "Voorkant") wich is the cover of my workbook. The TOC sheet (with page number) itself must also be listed in the TOC.On the TOC sheet, I want to create a button wich starts a macro. This macro must create/update the TOC

Every sheet has a title wich is entered into a single cell (always cel B1). This title is different from the sheet-name. It's ok for me to have all the titles listed in colom B and the pagenumbers in colom C. It would be great if it always in the same font, but I think this will go automatically if i enter these fonts in the Cell Propertie in wich the macro will put the titles and page numbers.

I hope it's clear to you.

Thanks
Gerben

[sdckapr]

How is this? It does overwrite the TOC sheet each time, but does NOT change the formatting. so if you format the range, it should stay with that format.

I assumed the TOC sheet name was named "TOC" and that in B1 of that sheet you wanted "Table of Contents", change this in the beginning of the code. I also set the TOC to start in col1, row 1 (with only the title in the defined spot in "B1". Change this as desired.

Steve

<pre>Option Explicit
Sub CreateTOC()
Dim sTOC As String
Dim sTOCName As String
Dim sSkipName As String
Dim sSkipName2 As String
Dim sTOCArray() As String
Dim vTOCArray()
Dim sNameLoc As String
Dim wkTOC As Worksheet
Dim iCol As Integer
Dim lRow As Long
Dim iNumTOC As Integer
Dim sht
Dim iNumPages As Integer
Dim iFirstPage As Integer
Dim x As Integer
Dim i As Integer

sTOC = "TOC"
sTOCName = "Table of Contents"
sSkipName = "BEREKENING"
sSkipName2 = "Voorkant"
sNameLoc = "B1"
lRow = 1
iCol = 1

Set wkTOC = Worksheets(sTOC)

wkTOC.Cells.ClearContents
wkTOC.Range(sNameLoc).Value = sTOCName

ReDim sTOCArray(1 To Sheets.Count)

For Each sht In Sheets
If sht.Name <> sSkipName And _
sht.Name <> sSkipName2 Then
x = x + 1
sTOCArray(x) = sht.Name
End If
Next sht
iNumTOC = x
ReDim Preserve sTOCArray(1 To iNumTOC)
ReDim vTOCArray(1, 1 To iNumTOC)
Sheets(sTOCArray).Select

iFirstPage = 0
x = 0
For Each sht In ActiveWindow.SelectedSheets
iNumPages = (sht.VPageBreaks.Count + 1) _
* (sht.HPageBreaks.Count + 1)
x = x + 1
vTOCArray(0, x) = sht.Range(sNameLoc)
vTOCArray(1, x) = iFirstPage + 1

iFirstPage = iFirstPage + iNumPages
Next sht

wkTOC.Select
With wkTOC
x = 1
.Cells(lRow + x, iCol) = "Worksheet"
.Cells(lRow + x, iCol + 1) = "Sheet Name"
.Cells(lRow + x, iCol + 2) = "Start Page"

For i = 1 To iNumTOC
x = x + 1
.Cells(lRow + x, iCol) = sTOCArray(i)
.Cells(lRow + x, iCol + 1) = vTOCArray(0, i)
.Cells(lRow + x, iCol + 2) = vTOCArray(1, i)

Next i
End With
End Sub</pre>

[gerbenhk]

Steve,

Great, it's almost exactly as I wanted it. A few things:

As you can see in the attachment,
1 the code is also filling in colom A with the names of the sheets, that's not neccesary.
2 The first sheet in de TOC is Inhoudsopgave (Thats TOC in dutch), thats ok, but in fact it's pagenr 2 because "Voorkant" is the first page
3 The next sheet is "Totaal investeringsoverzicht" that one is ok, because it is page number 3.But when you look at the next sheet named "About US" it has page number 5 instead 4.

thanks again,

Gerben

[sdckapr]

1) get rid of the lines:
.Cells(lRow + x, iCol) = "Worksheet"
.Cells(lRow + x, iCol) = sTOCArray(i)

2) You said you did not want to print "Voorkant". If it is NOT printed how could it have a page number?
3) I assume that "About US" starts on page 5 and NOT 4 since when you print "Totaal investeringsoverzicht" it is 2 pages long, so the 1st page is 3 and the 2nd page is 4. Thus the next page will print on start on page 5.

When you print out ALL the pages [Except for "Berekening" AND the first sheet (named: "Voorkant")] do the page numbers in the TOC match what the first page on those sheets are? The macro is getting the page numbers based on the number of PAGES that will be printed. It is not a listing of the sheet numbers.

Am I missing something? Listing the worksheet names would be much simpler code than trying to get the actual page numbers that excel will print.

Steve

[gerbenhk]

1) OK, fixed

2) I do want to print the sheet "Voorkant" but it's not nessesary to include it in the TOC. But if it makes it easier when we include the sheetname in the TOC, then it's no problem.

Maybe we can make it easier:
The names are ok wich are now displayed in the toc (colom [img]/forums/images/smilies/cool.gif[/img], so we don't have to do anything about that. Maybe you musn't get the pagenumber from the footer, but just count the sheets. So, as you can see in my JPG: Sheet "Voorkant" is always page 1, "inhoudsopgeve" is always page 2 etc
Al the sheets are 1 page long.

the last sheets is berekening and must not be entered in the TOC.

Gerben

[sdckapr]

I don't see how the sheets are only 1 page each. If/when you print some of them list as 4 pages. Are you printing with a different printer driver that the normal? I guess it doesn't matter.

You can't read the page numbers on the footers directly since if the right footer is setup to automatically paginate, if you read the footer it will just give you something like: "&P" and not a number. It doesn't put a number in until it actually prints. My code CALCULATES how many pages are on each sheet.

If you want the page numbers to just go up by 1 since they are only 1 page each, then this should work:

<pre>Option Explicit
Sub CreateTOCList()
Dim sTOC As String
Dim sSkipName As String
Dim sSkipTOC As String
Dim sTOCName As String
Dim sNameLoc As String
Dim wkTOC As Worksheet
Dim iCol As Integer
Dim lRow As Long
Dim sht
Dim x As Integer

sTOC = "Inhoudsopgave"
sTOCName = "Inhoudsopgave"
sSkipName = "BEREKENING"
sSkipTOC = "Voorkant"
sNameLoc = "B1"
lRow = 1
iCol = 1

Set wkTOC = Worksheets(sTOC)
With wkTOC
x = 1
.Cells.ClearContents
.Range(sNameLoc).Value = sTOCName
.Cells(lRow + x, iCol + 1) = "Sheet Name"
.Cells(lRow + x, iCol + 2) = "Start Page"

For Each sht In Sheets
If sht.Name <> sSkipName And _
sht.Name <> sSkipTOC Then
x = x + 1
.Cells(lRow + x, iCol + 1) = sht.Range(sNameLoc).Value
.Cells(lRow + x, iCol + 2) = x
End If
Next sht
End With
End Sub</pre>


If you do want to actually check the number of pages that will print for each sheet then this modification should work. Pagination MIGHT be different if you print to a different printer, if you do then you must set the activeprinter to that printer before checking the pagination! (if you want you can return it when you are done.

<pre>Option Explicit
Sub CreateTOC()
Dim sTOC As String
Dim sSkipName As String
Dim sSkipTOC As String
Dim sTOCName As String
Dim sNameLoc As String
Dim sTOCArray() As String
Dim vTOCArray()
Dim wkTOC As Worksheet
Dim iCol As Integer
Dim lRow As Long
Dim iNumTOC As Integer
Dim sht
Dim iNumPages As Integer
Dim iFirstPage As Integer
Dim x As Integer
Dim i As Integer

sTOC = "Inhoudsopgave"
sTOCName = "Inhoudsopgave"
sSkipName = "BEREKENING"
sSkipTOC = "Voorkant"
sNameLoc = "B1"
lRow = 1
iCol = 1

Set wkTOC = Worksheets(sTOC)
wkTOC.Cells.ClearContents
wkTOC.Range(sNameLoc).Value = sTOCName

ReDim sTOCArray(1 To Sheets.Count)

For Each sht In Sheets
If sht.Name <> sSkipName Then
x = x + 1
sTOCArray(x) = sht.Name
End If
Next sht
iNumTOC = x
ReDim Preserve sTOCArray(1 To iNumTOC)
ReDim vTOCArray(1, 1 To iNumTOC)
Sheets(sTOCArray).Select

iFirstPage = 0
x = 0
For Each sht In ActiveWindow.SelectedSheets
iNumPages = (sht.VPageBreaks.Count + 1) _
* (sht.HPageBreaks.Count + 1)
x = x + 1
vTOCArray(0, x) = sht.Range(sNameLoc).Value
vTOCArray(1, x) = iFirstPage + 1

iFirstPage = iFirstPage + iNumPages
Next sht
x = 1
wkTOC.Select
With wkTOC
.Cells(lRow + x, iCol + 1) = "Sheet Name"
.Cells(lRow + x, iCol + 2) = "Start Page"

For i = 1 To iNumTOC
If sTOCArray(i) <> sSkipTOC Then
x = x + 1
.Cells(lRow + x, iCol + 1) = vTOCArray(0, i)
.Cells(lRow + x, iCol + 2) = vTOCArray(1, i)
End If
Next i
End With
End Sub</pre>


Steve

[gerbenhk]

Steve,

Amazing how you make these things! It's working !
As final thing i want to insert two empty rows above "Sheet name" and "Start Page" and one empty row underneath it.

Then also one single row between each row where the pages are listed.
In the attachment you can see how i did it by hand.

tnx

Gerben

[sdckapr]

I am going to leave the complete answer as a learning excperience. The code that prints it is below. The item that controls how many rows from the starting row (lRow) is the variable x

You need to change 3 things:
1) the value of x to 2 more BEFORE you print the "titles"
2) after they print you want to increase it by 1.
3) BUT since x is also used to be the "page number" you must adjust the page number to print by decreasing x by 3 (=2+1)

Hint the first one can be done by changing a line below,
the second needs an additional line (hint: it goes in the blank row)
The 3rd is a modification to a the line that prints the page

Good Luck,
Steve

<pre> With wkTOC
x = 1
.Cells.ClearContents
.Range(sNameLoc).Value = sTOCName
.Cells(lRow + x, iCol + 1) = "Onderwerp"
.Cells(lRow + x, iCol + 2) = "Pagina"

For Each sht In Sheets
If sht.Name <> sSkipName And _
sht.Name <> sSkipTOC Then
x = x + 1
.Cells(lRow + x, iCol + 1) = sht.Range(sNameLoc).Value
.Cells(lRow + x, iCol + 2) = x
End If
Next sht
End With</pre>

[sdckapr]

For "extra credit" in your learning of the code:
There is a way to change the code (there are many ways actually to fix this) that is a "more generic way" to fix the code, though it involves more changes than just to "x". The advantage is that x stays as the page number and you use the lRow and iCol variables to DEFINE where you want the table to start. My original had the title as part of the TOC, but since we want to keep it in B1, we can use lRow as = 4 and iCol = 2 to signify that it starts in B4. This will involve changing other things, but like I said it is more "generic" in that just by changing icol and lrow the TOC will shift to any column and row you define to start.

Steve

[gerbenhk]

Steve,

Did you also give me the hint of adding an empty row underneath "Onderwerp" and "Pagina"?

Gerben

[gerbenhk]

Steve (or teacher ;-)),

I wasn't happy with the empty rows between each sheetsname, so i didn't do that (although i found out how to do that)
I removed the generation of the titles "onderwerp" and "Pagina". They are now fixed on the page.

I changed the code to start at the 6th row of the sheet. This is my final coding:

Option Explicit
Sub CreateTOCList()
Dim sTOC As String
Dim sSkipName As String
Dim sSkipTOC As String
Dim sTOCName As String
Dim sNameLoc As String
Dim wkTOC As Worksheet
Dim iCol As Integer
Dim lRow As Long
Dim sht
Dim x As Integer

sTOC = "Inhoudsopgave"
sTOCName = "Inhoudsopgave"
sSkipName = "Berekening"
sSkipTOC = "Voorkant"
sNameLoc = "B1"
lRow = 4
iCol = 1

Set wkTOC = Worksheets(sTOC)
With wkTOC
x = 1
For Each sht In Sheets
If sht.Name <> sSkipName And _
sht.Name <> sSkipTOC Then
x = x + 1
.Cells(lRow + x, iCol + 1) = sht.Range(sNameLoc).Value
.Cells(lRow + x, iCol + 2) = x
End If
Next sht
End With
End Sub


Thanks again for your support

Gerben