Как добавить оглавление в файл LibreOffice Calc?

Question

Добавление ToC в LO Writer не проблема, но как вставить ToC в файл ods ? Для книги с таблицами длиннее одной страницы, которая будет распространяться в виде распечатки (не в виде файла), было бы неплохо иметь ToC на первом листе, перечисляя все другие листы в том же файле ods с номерами страниц.

Я попытался вставить OLE-объект Writer, который позволяет добавить ToC (внутри объекта OLE ...), но объект, похоже, игнорирует заголовки из других листов. Вставка имен листов с использованием гиперссылок была бы в порядке, но я не нашел способа также вставить номера страниц.

Если для этого потребуется макрос (предпочтительно StarBasic), я предложу вознаграждение.

Есть идеи?

PS: Я нашел Q /A на форумах OpenOffice.org, начиная с 2008 года, но я не понимаю, как это реализовать ...

Answer 1

Хорошо, вот код, который я придумал:

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

Вероятно, было бы неплохо поместить этот код в собственный модуль, так как он очень большой. Затем, чтобы запустить его, перейдите в Tools -> Macros -> Run Macro и выполните процедуру CalcTableOfContents .

Чтобы получить правильные номера страниц, есть одна важная хитрость. Код проверяет только номер страницы каждой ячейки. Таким образом, если содержимое ячейки пересекается на две страницы, оно будет считать только первую страницу.

Чтобы устранить эту проблему, добавьте содержимое в ячейку на второй странице. Установите его для печати, перейдя в « Format -> Cells -> Cell Protection и отметив «Скрыть при печати». Это заставит макрос распознавать вторую страницу.

Если все идет хорошо, он должен показать такой результат на листе 1:

Кредиты:

• Несмотря на то, что он не предлагает решения, Villeroy довольно подробно исследовал эту проблему, например, https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58812.
• Коллекции были большой помощью в написании кода на Basic по запросу. Документации практически нет, но смотрите https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=2953. Также актуальна документация VB6.
• Похожие вопросы: https://stackoverflow.com/questions/781105/how-can-the-no-of-pages-in-an-openoffice-org-spreadsheet-be-obtained-programmat.

Answer 2

Вот другой подход. Я задавался вопросом, есть ли способ определить разрывы страниц с помощью IsStartOfNewPage . Это работает после того, как LO Calc вычислит разрывы страниц, переключившись в PageBreak View и обратно. Теперь подсчет страниц довольно прост, итерируя по всем используемым ячейкам (используя Cursor текущего листа и GotoEndOfUsedArea).

Я не проверял, приведет ли ячейка, занимающая несколько страниц, к неправильному количеству страниц. Кроме того, я предполагаю, что полученный ToC никогда не займет больше одной страницы.

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

Я использовал пример кода Эндрю Питоняка (« Полезная информация о макросах для OpenOffice.org Эндрю Питоняка (ODT) » и « Объясненные макросы OpenOffice.org (PDF) ») и модуля интроспекции Villeroy's Cell, и, конечно, некоторые из Решение JimK.

РЕДАКТИРОВАТЬ:

Макрос не проверяет каждую страницу, если он содержит печатный контент. Это просто предполагает, что полный "используемый" диапазон ячеек (идентифицируемый с помощью GotoEndOfUsedArea) должен быть принят во внимание при создании ToC. Таким образом, он может считать пустые страницы как страницы для печати. Таким образом, это может привести к плохим результатам для редко заполненных листов. Но я надеюсь, что он ведет себя более надежно в большинстве случаев, когда нет пустых страниц.

Таким образом, ожидается, что следующие листы будут напечатаны на шести страницах, даже если одна страница (без X) может остаться пустой:

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