Wie füge ich einer LibreOffice Calc-Datei ein Inhaltsverzeichnis hinzu?

Ok, hier ist der Code, den ich mir ausgedacht habe:

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 

Es ist wahrscheinlich eine gute Idee, diesen Code in ein eigenes Modul zu schreiben, da er so groß ist. Um es auszuführen, gehen Sie zur Routine Tools -> Macros -> Run Macround führen Sie sie aus CalcTableOfContents.

Damit es die richtigen Seitenzahlen erhält, gibt es einen wichtigen Trick. Der Code prüft nur die Seitennummer jeder Zelle. Wenn sich also der Inhalt einer Zelle auf zwei Seiten kreuzt, wird nur die erste Seite gezählt.

Fügen Sie in einer Zelle auf der zweiten Seite Inhalt hinzu, um dieses Problem zu beheben. Setzen Sie es auf "Nicht druckbar Format -> Cells -> Cell Protection", indem Sie "Ausblenden beim Drucken" auswählen. Dadurch wird das Makro gezwungen, die zweite Seite zu erkennen.

Wenn alles gut geht, sollte es auf Blatt 1 so aussehen:

Credits:

• Obwohl er keine Lösung anbietet, hat Villeroy dieses Problem gründlich untersucht, beispielsweise https://forum.openoffice.org/de/forum/viewtopic.php?f=20&t=58812 .
• Sammlungen waren eine große Hilfe beim Schreiben des Codes in Basic. Es gibt praktisch keine Dokumentation, siehe jedoch https://forum.openoffice.org/de/forum/viewtopic.php?f=20&t=2953 . Auch die VB6-Dokumentation ist relevant.
• Zugehörige Frage: https://stackoverflow.com/questions/781105/wie-kann-die-no-von-seiten-in-an-openoffice-org-spreadsheet-weiterbestellt werden .

Hier ist ein anderer Ansatz. Ich fragte mich, ob es eine Möglichkeit gibt, die Seitenumbrüche mithilfe von zu bestimmen IsStartOfNewPage. Dies funktioniert, nachdem LO Calc die Seitenumbrüche berechnet hat, indem in die PageBreak-Ansicht und zurück gewechselt wird. Das Zählen von Seiten ist jetzt recht einfach, indem alle verwendeten Zellen durchlaufen werden (mit dem aktuellen Blatt Cursorund GotoEndOfUsedArea).

Ich habe nicht getestet, ob Zellen, die sich über mehrere Seiten erstrecken, zu einer falschen Seitenzahl führen. Ich gehe außerdem davon aus, dass der resultierende ToC niemals mehr als eine Seite dauern wird.

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 

Ich habe einige Beispiel - Code von Andrew Pitonyak ( „verwendet Nützliche Makro Informationen für OpenOffice.org Von Andrew Pitonyak (ODT) ‚und‘ OpenOffice.org Makros Erklärung (PDF) “) und von Villeroy Cell Selbstbeobachtung Modul und natürlich einige JimKs Lösung .

BEARBEITEN:

Das Makro testet nicht jede Seite, wenn es druckbaren Inhalt enthält. Es wird lediglich davon GotoEndOfUsedAreaausgegangen, dass der gesamte "verwendete" Zellbereich (identifiziert mit ) beim Erstellen des ToC berücksichtigt werden sollte. Daher können leere Seiten als zu druckende Seiten gezählt werden. Daher kann es bei dünn gefüllten Blättern zu schlechten Ergebnissen kommen. Ich hoffe jedoch, dass es sich in den meisten Fällen, in denen keine leeren Seiten vorhanden sind, zuverlässiger verhält.

Es wird also davon ausgegangen, dass die folgenden Blätter auf sechs Seiten gedruckt werden, auch wenn eine Seite (ohne X) leer bleiben kann:

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