Adicionar um ToC no LO Writer não é problema, mas como inserir um ToC em um ods
arquivo? Para que uma pasta de trabalho com tabelas com mais de uma página seja distribuída como impressão (não como arquivo), seria bom ter um ToC na primeira planilha, listando todas as outras planilhas no mesmo ods
arquivo com números de página.
Tentei inserir um objeto Writer OLE, que permite adicionar um ToC (dentro do objeto OLE...), mas o objeto parece ignorar os títulos das outras planilhas. Inserir os nomes das planilhas usando hiperlinks seria aceitável, mas não encontrei como inserir também os números das páginas.
Se isso exigir uma macro (de preferência StarBasic), oferecerei uma recompensa.
Alguma ideia?
PS: eu encontreiperguntas e respostas nos fóruns do OpenOffice.orgdatado de 2008, mas não entendo como implementá-lo...
Responder1
Ok, aqui está o código que criei:
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
Provavelmente é uma boa ideia colocar esse código em seu próprio módulo, já que ele é muito grande. Então, para executá-lo, acesse Tools -> Macros -> Run Macro
e execute a CalcTableOfContents
rotina.
Para obter os números de página corretos, existe um truque importante. O código verifica apenas o número da página de cada célula. Portanto, se o conteúdo de uma célula cruzar duas páginas, ela contará apenas a primeira página.
Para solucionar esse problema, adicione algum conteúdo em uma célula da segunda página. Defina-o como não imprimível acessando Format -> Cells -> Cell Protection
e marcando "Ocultar ao imprimir". Isso forçará a macro a reconhecer a segunda página.
Se tudo correr bem, deverá mostrar um resultado como este na folha 1:
Créditos:
- Embora não ofereça uma solução, Villeroy pesquisou bastante esse problema, por exemplohttps://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=58812.
- As coleções foram de grande ajuda na escrita do código em Basic conforme solicitado. Praticamente não há documentação, mas vejahttps://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=2953. Também oDocumentação VB6é relevante.
- Pergunta relacionada:https://stackoverflow.com/questions/781105/how-can-the-no-of-pages-in-an-openoffice-org-spreadsheet-be-obtained-programmat.
Responder2
Aqui está uma abordagem diferente. Gostaria de saber se existe uma maneira de determinar as quebras de página usando IsStartOfNewPage
. Isso funciona depois de fazer o LO Calc calcular as quebras de página, alternando para o PageBreak View e vice-versa. Agora, contar páginas é bastante fácil, iterando todas as células usadas (usando Cursor
e da planilha atual GotoEndOfUsedArea
).
Não testei se células que abrangem várias páginas levariam a uma contagem incorreta de páginas. Além disso, presumo que o ToC resultante nunca ocupará mais de uma página.
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
Usei alguns exemplos de código de Andrew Pitonyak ("Informações úteis sobre macros para OpenOffice.org por Andrew Pitonyak (ODT)" e "Macros do OpenOffice.org explicadas (PDF)") e porMódulo de introspecção celular de Villeroye, claro, algunsA solução de JimK.
EDITAR:
A macro não testa todas as páginas se elas contêm conteúdo imprimível. Ele simplesmente assume que o intervalo completo de células "usadas" (identificadas usando GotoEndOfUsedArea
) deve ser levado em consideração ao criar o ToC. Assim, pode contar páginas vazias como páginas a serem impressas. Portanto, pode produzir resultados ruins para planilhas pouco preenchidas. Mas espero que ele se comporte de maneira mais confiável na maioria dos casos em que não há páginas vazias.
Portanto, espera-se que as seguintes folhas sejam impressas em seis páginas, mesmo que uma página (sem X
) fique vazia:
+-+-+ +-+-+ +-+-+
|X|X| |X|X| |X| |
+-+-+ +-+-+ +-+-+
|X| | | |X| | | |
+-+-+ +-+-+ +-+-+
|X|X| |X|X| | |X|
+-+-+ +-+-+ +-+-+