LibreOffice Calc dosyasına bir içindekiler tablosu nasıl eklenir?

LO Writer'a bir ToC eklemek sorun değil, ancak bir ToC eklemek ods dosya? Çıktı olarak dağıtılacak bir sayfadan daha uzun tablolara sahip bir çalışma kitabı (dosya olarak değil), ilk sayfada bir ToC’ye sahip olmak ve aynı sayfadaki diğer tüm sayfaları listelemek iyi olurdu. ods sayfa numaraları ile dosya.

Bir ToC eklemeyi sağlayan (OLE nesnesinin içinde ...) bir Yazar OLE Nesnesi eklemeye çalıştım, ancak nesne diğer sayfalardaki Başlıkları yok sayıyor gibi görünüyor. Sayfa adlarını köprüler kullanarak eklemek iyi olurdu, ancak sayfa numaralarını da eklemenin bir yolunu bulamadım.

Bu makro gerektiriyorsa (StarBasic tercih edilir), bir ödül sunarım

Herhangi bir fikir?

PS: Buldum OpenOffice.org forumlarında soru sorma 2008’den kalma ama nasıl uygulanacağını bilmiyorum ...

Tamam, işte geldiğim kod:

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

Muhtemelen bu kodu çok büyük olduğundan kendi modülüne koymak iyi bir fikirdir. Sonra koşmak için git Tools -> Macros -> Run Macro ve yürütmek CalcTableOfContents rutin.

Doğru sayfa numaralarını elde etmek için önemli bir numara var. Kod sadece her hücrenin sayfa numarasını kontrol eder. Yani bir hücrenin içeriği iki sayfaya geçerse, yalnızca ilk sayfayı sayar.

Bu sorunu çözmek için, ikinci sayfadaki bir hücreye biraz içerik ekleyin. Giterek yazdırılabilir değil olarak ayarlayın. Format -> Cells -> Cell Protection ve "Yazdırırken gizle" seçeneğini işaretleyin. Bu makroyu ikinci sayfayı tanımaya zorlar.

Her şey yolunda giderse, sayfa 1'de böyle bir sonuç göstermelidir:

Kredi:

• Çözüm sunmasa da, Villeroy bu sorunu biraz araştırdı, örneğin https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58812 .
• Koleksiyonlar, istenildiği gibi Temel dilinde kod yazarken çok yardımcı oldu. Neredeyse hiçbir dokümantasyon yok, ancak bkz. https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=2953 . Ayrıca VB6 belgeleri alakalı.
• İlgili soru: https://stackoverflow.com/questions/781105/how-can-the-no-of-pages-in-an-openoffice-org-spreadsheet-be-obtained-programmat .

İşte farklı bir yaklaşım. Kullanarak sayfa sonlarını belirlemenin bir yolu olup olmadığını merak ettim. IsStartOfNewPage. Bu, LO Calc'ı Sayfa Sonu Görünümü'ne ve geriye doğru geçiş yaparak sayfa sonlarını hesaplayarak yapar. Şimdi, sayfaları saymak, kullanılan tüm hücreleri (geçerli sayfanın sayfasını kullanarak) yineleyerek oldukça kolaydır. Cursor ve GotoEndOfUsedArea ).

Birden fazla sayfayı kapsayan hücrelerin yanlış sayfa sayımına yol açıp açmayacağını test etmedim. Ayrıca, ortaya çıkan ToC’nin asla birden fazla sayfa almayacağını tahmin ediyorum.

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 tarafından bazı örnek kodlar kullandım (" OpenOffice.org İçin Faydalı Makro Bilgiler Andrew Pitonyak (ODT) tarafından " ve " OpenOffice.org Makrolar Açıklaması (PDF) ") ve tarafından Villeroy'un Hücre inceleme modülü ve tabii ki JimK'nin çözümü .

DÜZENLE:

Makro, yazdırılabilir içerik içeriyorsa her sayfayı test etmez. Basitçe, "kullanılmış" tam hücre aralığının ( GotoEndOfUsedArea ToC oluşturulurken) dikkate alınmalıdır. Bu nedenle, boş sayfaları yazdırılacak sayfalar olarak sayabilir. Bu nedenle, seyrek dolgulu sayfalar için kötü sonuçlar doğurabilir. Ancak umarım boş sayfa olmayan çoğu durumda daha güvenilir davranır.

Bu nedenle, bir sonraki sayfada (aşağıdaki sayfalar olmasa bile) altı sayfaya yazdırılacak X ) boş kalabilir:

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