How to add a Table of Contents to a LibreOffice Calc file?

Question

Adding a ToC in LO Writer is no problem, but how to insert a ToC in a ods file? For a workbook with tables longer than one page to be distributed as printout (not as file), it would be nice to have a ToC at the first sheet, listing all other sheets in the same ods file with page numbers.

I've tried to insert a Writer OLE Object, which allows for adding a ToC (inside the OLE object...), but the object seems to ignore the Headings from the other sheets. Inserting the sheet names using hyperlinks would be ok, but i found no way to also insert the page numbers.

If this requires a macro (StarBasic preferred), i'll offer a bounty.

Any ideas?

PS: I've found a Q/A in the OpenOffice.org forums dating from 2008, but i don't understand how to implement it...

Answer 1

Ok, here is the code I came up with:

Type PageBreakLocation
    Row As Long
    Col As Long
    Sheet As Long
End Type

Function GetLocationKey(item As PageBreakLocation)
    GetLocationKey = "s" & item.Sheet & "r" & item.Row & "c" & item.Col
End Function

Type PageOfSheet
    Sheet As Long
    Page As Long
End Type

Sub CalcTableOfContents
    used_pages = FindAllUsedPages()
    page_of_each_sheet = GetPageOfEachSheet(used_pages)
    Insert_TOC(page_of_each_sheet)
    DisplayContents(page_of_each_sheet)
End Sub

Sub DisplayContents(page_of_each_sheet As Collection)
    msg = ""
    For Each value In page_of_each_sheet
        sheet_name = ThisComponent.Sheets.getByIndex(value.Sheet).getName()
        msg = msg & "Sheet(" & value.Sheet & ") """ & sheet_name & _
            """ .....Page " & value.Page & CHR(13)
    Next
    MsgBox msg
End Sub

' Insert a Table of Contents into sheet 1.
Sub Insert_TOC(page_of_each_sheet As Collection)
    oSheet = ThisComponent.Sheets.getByIndex(0)
    oCell = oSheet.getCellByPosition(1, 1)  'B2
    oCell.SetString("Table of Contents")
    row = 3   ' the fourth row
    For Each value In page_of_each_sheet
        oCell = oSheet.getCellByPosition(1, row)  ' column B
        oCell.SetString(ThisComponent.Sheets.getByIndex(value.Sheet).getName())
        oCell = oSheet.getCellByPosition(3, row)  ' column D
        oCell.SetString("Page " & value.Page)
        row = row + 1
    Next
End Sub

' Returns a collection with key as sheet number and item as page number.
Function GetPageOfEachSheet(used_pages As Collection)
    Dim page_of_each_sheet As New Collection
    page_number = 1
    For Each used_page In used_pages
        key = CStr(used_page.Sheet)
        If Not Contains(page_of_each_sheet, key) Then
            Dim value As New PageOfSheet
            value.Sheet = used_page.Sheet
            value.Page = page_number
            page_of_each_sheet.Add(value, key)
        End If
        page_number = page_number + 1
    Next
    GetPageOfEachSheet = page_of_each_sheet
End Function

' Looks through all used cells and adds those pages.
' Returns a collection of used pages.
Function FindAllUsedPages
    Dim used_pages As New Collection
    For Each addr in GetFilledRanges()
        FindPagesForRange(addr, used_pages)
    Next
    FindAllUsedPages = used_pages
End Function

' Returns an array of filled cells.
' Elements are type com.sun.star.table.CellRangeAddress.
' Note: oSheet.getPrintAreas() seemed like it might do this, but in testing,
'       it always returned empty.
Function GetFilledRanges
    allRangeResults = ThisComponent.createInstance( _
        "com.sun.star.sheet.SheetCellRanges")
    For i = 0 to ThisComponent.Sheets.getCount() - 1
        oSheet = ThisComponent.Sheets.getByIndex(i)
        With com.sun.star.sheet.CellFlags
            printable_content = .VALUE + .DATETIME + .STRING + .ANNOTATION + _
                                .FORMULA + .OBJECTS
        End With
        filled_cells = oSheet.queryContentCells(printable_content)
        allRangeResults.addRangeAddresses(filled_cells.getRangeAddresses(), False)
    Next
    ' Print allRangeResults.getRangeAddressesAsString()
    GetFilledRanges = allRangeResults.getRangeAddresses()
End Function

' Looks through the range and adds any pages to used_pages.
' Note: row.IsStartOfNewPage is only for manual breaks, so we do not use it.
Sub FindPagesForRange(range As Object, used_pages As Collection)
    oSheet = ThisComponent.Sheets.getByIndex(range.Sheet)
    aPageBreakArray = oSheet.getRowPageBreaks()
    Dim used_row_breaks() As Variant
    Dim used_col_breaks() As Variant
    prev_break_row = 0
    For nIndex = 0 To UBound(aPageBreakArray())
        break_row = aPageBreakArray(nIndex).Position
        If break_row = range.StartRow Then
            Append(used_row_breaks, break_row)
        ElseIf break_row > range.StartRow Then
            Append(used_row_breaks, prev_break_row)
        End If
        If break_row > range.EndRow Then
            Exit For
        End If
        prev_break_row = break_row
    Next
    prev_break_col = 0
    aPageBreakArray = oSheet.getColumnPageBreaks()
    For nIndex = 0 To UBound(aPageBreakArray())
        break_col = aPageBreakArray(nIndex).Position
        If break_col = range.StartColumn Then
            Append(used_col_breaks, break_col)
        ElseIf break_col > range.StartColumn Then
            Append(used_col_breaks, prev_break_col)
        End If
        If break_col > range.EndColumn Then
            Exit For
        End If
        prev_break_col = break_col
    Next
    For Each row In used_row_breaks()
        For Each col In used_col_breaks()
            Dim location As New PageBreakLocation
            location.Sheet = range.Sheet
            location.Row = row
            location.Col = col
            key = GetLocationKey(location)
            If Not Contains(used_pages, key) Then
                used_pages.Add(location, key)
            End If
        Next col
    Next row
End Sub

' Returns True if the collection contains the key, otherwise False.
Function Contains(coll As Collection, key As Variant)
    On Error Goto ErrorHandler
    coll.Item(key)
    Contains = True
    Exit Function
ErrorHandler:
    If Err <> 5 Then
         MsgBox "Error " & Err & ": " & Error$ & " (line : " & Erl & ")"
    End If
    Contains = False
End Function

' Append an element to an array, increasing the array's size by 1.
Sub Append(array() As Variant, new_elem As Variant)
    old_len = UBound(array)
    ReDim Preserve array(old_len + 1) As Variant
    array(old_len + 1) = new_elem
End Sub

It's probably a good idea to put this code in its own module since it's so large. Then to run it, go to Tools -> Macros -> Run Macro and execute the CalcTableOfContents routine.

To make it get the right page numbers, there is one important trick. The code only checks the page number of each cell. So if a cell's contents crosses into two pages, it will only count the first page.

To remedy this problem, add some content in a cell on the second page. Set it to not printable by going to Format -> Cells -> Cell Protection and checking "Hide when printing." This will force the macro to recognize the second page.

If all goes well, it should show a result like this on sheet 1:

Credits:

• Although he does not offer a solution, Villeroy has researched this problem quite a bit, for example https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58812.
• Collections were a big help in writing the code in Basic as requested. There is virtually no documentation, but see https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=2953. Also the VB6 documentation is relevant.
• Related question: https://stackoverflow.com/questions/781105/how-can-the-no-of-pages-in-an-openoffice-org-spreadsheet-be-obtained-programmat.

Answer 2

Here's a different approach. I wondered if there's a way to determine the page breaks using IsStartOfNewPage. This works after making LO Calc calculating the page breaks by switching into the PageBreak View and back. Now, counting pages is quite easy by iterating over all used cells (using the current sheet's Cursor and GotoEndOfUsedArea).

I didn't test if cells spanning multiple pages will lead to wrong page count. Also, i assume that the resulting ToC will never take more than one page.

Option Base 0
Option Explicit

Private Type SheetInformation
    SheetIndex As Long
    SheetName As String
    PageStart as Long
    PageEnd as Long
    PageCount As Long
End Type

Public Sub Calc_ToC

    If (False = IsSpreadsheetDoc(ThisComponent)) Then
        MsgBox "Works only for spreadsheets!"
        Exit Sub
    End If
    ThisComponent.LockControllers

    Dim mySheets(ThisComponent.Sheets.getCount() - 1) As New SheetInformation
    Dim origSheet As Long
    origSheet = ThisComponent.getCurrentController.ActiveSheet.RangeAddress.Sheet

    Call collectSheetInfo(mySheets)

    dim document   as Object
    dim dispatcher as Object
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "Nr"
    args1(0).Value = origSheet + 1
    dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())

    ThisComponent.unlockControllers()

    Call insertToc(mySheets)

End Sub

Private Sub collectSheetInfo(allSheetsInfo() as New SheetInformation)
    Dim i As Long
    Dim maxPage As Long
    maxPage = 0

    For i = 0 To UBound(allSheetsInfo)
        Dim sheetInfo As New SheetInformation
        sheetInfo.SheetIndex = i
        sheetInfo.SheetName = ThisComponent.Sheets.getByIndex(sheetInfo.SheetIndex).getName()
        Call getPageCount(sheetInfo)
        sheetInfo.PageStart = maxPage + 1
        sheetInfo.PageEnd = sheetInfo.PageStart + sheetInfo.PageCount - 1
        maxPage = sheetInfo.PageEnd
        allSheetsInfo(i) = sheetInfo
    Next

End Sub

Private Sub getPageCount(s As SheetInformation)
    Dim oSheet, oCell, oCursor As Object
    Dim i, j, pageCount As Long
    Dim isHorizontalPageBreak, isVerticalPageBreak As Boolean

    dim document   as Object
    dim dispatcher as Object
    document   = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

    dim args1(0) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "Nr"
    args1(0).Value = s.SheetIndex + 1
    dispatcher.executeDispatch(document, ".uno:JumpToTable", "", 0, args1())

    args1(0).Name = "PagebreakMode"
    args1(0).Value = true
    dispatcher.executeDispatch(document, ".uno:PagebreakMode", "", 0, args1())
    dim args2(0) as new com.sun.star.beans.PropertyValue
    args2(0).Name = "NormalViewMode"
    args2(0).Value = true
    dispatcher.executeDispatch(document, ".uno:NormalViewMode", "", 0, args2())

    oSheet = ThisComponent.Sheets.getByIndex(s.SheetIndex)

    oCursor = oSheet.createCursor
    oCursor.GotoEndOfUsedArea(True)

    pageCount = 1

    For i=0 To oCursor.RangeAddress.EndColumn
        For j=0 To oCursor.RangeAddress.EndRow
            oCell = oSheet.GetCellByPosition(i,j)
            isHorizontalPageBreak = Abs(cINT(oCell.Rows.getByIndex(0).IsStartOfNewPage))
            isVerticalPageBreak = Abs(cINT(oCell.Columns.getByIndex(0).IsStartOfNewPage))
            If i = 0 Then
                If isHorizontalPageBreak Then
                    pageCount = pageCount + 1
                End If
            ElseIf j = 0 Then
                If isVerticalPageBreak Then
                    pageCount = pageCount + 1
                End If
            Else
                If (isHorizontalPageBreak AND isVerticalPageBreak) Then
                    pageCount = pageCount + 1
                End if
            End if
        Next j
    Next i
    s.pageCount = pageCount

End Sub

''' -------------------------------------------------------------
''' IsSpreadsheetDoc - Check if current document is a calc file
''' -------------------------------------------------------------
''' Source: "Useful Macro Information For OpenOffice.org By
''' Andrew Pitonyak", Ch. 6.1
''' -------------------------------------------------------------
Private Function IsSpreadsheetDoc(oDoc) As Boolean
  Dim s$ : s$ = "com.sun.star.sheet.SpreadsheetDocument"
  On Local Error GoTo NODOCUMENTTYPE
  IsSpreadsheetDoc = oDoc.SupportsService(s$)
  NODOCUMENTTYPE:
  If Err <> 0 Then
     IsSpreadsheetDoc = False
    Resume GOON
    GOON:
  End If
End Function

Private Sub Result(s() As SheetInformation)
    Dim msg As String
    Dim i As Integer
    Dim obj As SheetInformation
    msg = ""

    For i = 0 To UBound(s)
        obj = s(i)
        With obj
            msg = msg & .SheetName & " (Index: " & .SheetIndex & _
            ") - Pages: " & .PageCount & _
            " - from/to: " & .PageStart & "/" & .PageEnd & CHR(13)
        End With
    Next
    MsgBox(msg)
End Sub

Private Sub insertToC(s() As SheetInformation)

    Select Case MsgBox("Insert ToC on cursor position?" & CHR(10) & _
        "(Yes: Insert at cursor; No: stop macro)", 36)
        Case 6 'Yes - insert at cursor position'
            Call DoInsert(s)
        Case 7 'No - insert on new sheet'
            ThisComponent.unlockControllers()
            Exit Sub
    End Select
End Sub

Private Sub DoInsert(s() As SheetInformation)

    Dim oSheet, oCell, startCell As Object
    Dim sheet,rowStart, colStart, row, col, start As Long
    Dim sName As String
    Dim currentSheet As SheetInformation
    Dim newToc As Boolean

    oSheet = ThisComponent.getCurrentController.ActiveSheet
    startCell = ThisComponent.getCurrentSelection() 
    oCell = startCell
    rowStart = startCell.CellAddress.Row
    colStart = startCell.CellAddress.Column
    oCell.SetString("Table of Contents")
    For sheet = 1 to Ubound(s) + 1
        currentSheet = s(sheet - 1)
        row = rowStart + sheet
        oCell = oSheet.getCellByPosition(colStart, row)  ' column B
        oCell.SetString(currentSheet.SheetName)
        oCell = oSheet.getCellByPosition(colStart + 2, row)  ' column D
        start = currentSheet.PageStart

        oCell.SetString("Page " & start)
    Next
    ThisComponent.unlockControllers()
End Sub

I've used some example code by Andrew Pitonyak ("Useful Macro Information For OpenOffice.org By Andrew Pitonyak (ODT)" and "OpenOffice.org Macros Explained (PDF)") and by Villeroy's Cell introspection module, and of course some of JimK's solution.

EDIT:

The macro doesn't test every page if it contains printable content. It simply assumes that the complete "used" cell range (identified using GotoEndOfUsedArea) should be taken into account when creating the ToC. Thus, it may count empty pages as pages to print. So, it might yield bad results for sparsely filled sheets. But i hope it behaves more reliably for most cases where there are no empty pages.

So, it will expect the following sheets to be printed on six pages, even if one page (without X) may stay empty:

+-+-+     +-+-+     +-+-+
|X|X|     |X|X|     |X| |
+-+-+     +-+-+     +-+-+
|X| |     | |X|     | | |
+-+-+     +-+-+     +-+-+
|X|X|     |X|X|     | |X|
+-+-+     +-+-+     +-+-+