如何向 LibreOffice Calc 文件添加目录？

Question 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

好的，这是我想到的代码：

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。

Question 2

这是另一种方法。我想知道是否有办法使用来确定分页符。通过切换到 PageBreak View 并返回，让 LO Calc 计算分页符后，这种方法有效。现在，通过遍历所有使用的单元格（使用当前工作表的和），IsStartOfNewPage计数页数变得非常容易。CursorGotoEndOfUsedArea

我没有测试跨多页的单元格是否会导致页数错误。另外，我假设生成的目录永远不会超过一页。

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

我使用了 Andrew Pitonyak 的一些示例代码（“适用于 OpenOffice.org 的有用宏信息，作者：Andrew Pitonyak (ODT)“ 和 ”OpenOffice.org 宏说明 (PDF)“）以及Villeroy 的 Cell 自省模块，当然还有一些JimK 的解决方案。

编辑：

如果每页都包含可打印内容，则宏不会对其进行测试。它只是假设GotoEndOfUsedArea在创建目录时应考虑完整的“已使用”单元格范围（使用标识）。因此，它可能会将空白页计为要打印的页面。因此，对于填充稀疏的纸张，它可能会产生不良结果。但我希望在大多数情况下，在没有空白页的情况下，它的表现会更可靠。

X因此，即使有一页（没有）可能保持为空白，它也期望将以下纸张打印在六页上：

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

Answer