Getting a sorted overview of all the annotations contained in a Writer document

[Lupp]

In pursuit of a badly worded question in the "Macros" forum I used some time to develop a solution for which now the problem (question) is missing.
Possibly there are a few visitors interested in the code.
I will also attach a demonstrating .odt.
Note (1): The currently fresh LibO version 24.2.1 has a bug thwaiting the way to get position info for annotation anchors.
===Edit 2024-03-30 about 14:50 UTC===
With V 24.2.2.2 the bug seems to be fixed.
See https://bugs.documentfoundation.org/sho ... ?id=160138
===/Edit===
Note (2): AOO and very old versions of LibO dont't support non-empty text ranges as anchors for annotations. The info 'AnchorString' will then be empty even if the document was made with a newer version.

Code: Select all

Sub collectWriterAnnotationsInfo(Optional pDoc)
Dim annoStripes As New Collection
If IsMissing(pDoc) Then pDoc = ThisComponent
currCtrl   = pDoc.CurrentController
foundSel   = currCtrl.Selection
viewCur    = currCtrl.ViewCursor
textFields = pDoc.TextFields
For Each field In textFields
 If NOT field.supportsService("com.sun.star.text.textfield.Annotation") _
  Then Goto nextField
 With field
  REM Get positionalInformation. This requires to select the anchor.
  REM This is currently (2024-03-11) not working for me in LibO V 24.2.
  REM It works in all my older Portable versions an also in AOO 4.1.7.
  currCtrl.select(.Anchor)
  With viewCur
   page       = .Page
   With .Position
    posY       = .Y
    posX       = .X
   End With
  End With
  annoDate    = .Date
  With annoDate
   isoDate     = Join(Array(Format(.Year, "0000"), _
                            Format(.Month, "00") , _
                            Format(.Day,"00"))   , "-")
  End With
  annoStripe  = Array(page,    posY,    posX, .  Anchor.String, _
                     isoDate, .Author, .Content)
  annoStripes.add(annoStripe)
 End With
nextField:
Next field
currCtrl.select(foundSel)
Call annotationInfoToSheet(annoStripes)
fail:
End Sub

Sub annotationInfoToSheet(pCollection, Optional pSheet)
If IsMissing(pSheet) Then
 calcDoc    = StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Array())
 pSheet     = calcDoc.Sheets(0)
Else
 calcDoc    = pSheet.DrawPage.Forms.Parent
EndIf
headers    = Array("Page",                        _
                   "AnchorPos.Y",  "AnchorPos.X", _
                   "AnchorString", "Date",        "Author", "ContentString")
uH         = Ubound(headers)
headersRg  = pSheet.getCellRangeByPosition(0, 0, uH, 0)
headersRg.setDataArray(Array(headers))
workCursor = pSheet.createCursorByRange(headersRg)
For Each annoStripe In pCollection
 workCursor.gotoOffset(0, 1)
 workCursor.setDataArray(Array(annoStripe))
Next annoStripe
tally      = pCollection.Count
workCursor.gotoOffset(0, -tally + 1)
workCursor.collapseToSize(Ubound(headers) + 1, tally)
Dim sortDescr(2) As New com.sun.star.beans.PropertyValue' = workCursor.createSortDescriptor()
Dim sortFields(1) As New com.sun.star.util.SortField
sortFields(0).SortAscending = True                   : sortFields(0).Field = 1
sortFields(1).SortAscending = True                   : sortFields(1).Field = 2
sortDescr(0).Name           = "ContainsHeader"       : sortDescr(0).Value  = False
sortDescr(1).Name           = "SortFields"           : sortDescr(1).Value  = sortFields
sortDescr(2).Name           = "BindFormatsToContent" : sortDescr(0).Value  = False
workCursor.sort(sortDescr)
calcDoc.currentController.select(workCursor)
End Sub

annotationExperiments.odt

(35.1 KiB) Downloaded 16 times

[JeJe]

Thanks for the idea, I've applied your cunning method to textsections. Its much simpler than enumerating all the paragraphs.

viewtopic.php?t=111347

As I say there, In the past I have had issues with Writer not always updating the viewcursor position properly when the cursor is moved- so that may or may not occur.