So, I have a writer doc with a table and the first cell’s text is set as a “Heading 3”. How do I get that headings reference, like what a hyperlink would need to jump to that heading? I’m looking for that reference you get when making a hyperlink with the UI when it lets you pick which heading to want to jump to.
Here is the example doc.
MT script test doc6.odt (29.6 KB)
The Target in Document dialog is filled using XLinkTargetSupplier (recursively).
The fragment part is filled simply prepending the target name (which is one of the element names of the links) with # (no URL-encoding).
Excellent! So,XLinkTargetSupplier gets me to oDoc.Links and because I’m looking for headings the addition of .GetByName(“Headings”) brings me a list I can use, somehow. I’m closer than I was, thank you!
Yes, that was the same issue but from the other end. The solution turned out not to work as well as needed so that line was abandoned and the new strategy was adapted, storing that ID. So, storing the ID could be abandoned and this new code could be used in hyperlink creation. It makes more sense that way.
mikekaganski’s comment about XLinkTargetSupplier lead me to the Links object of the same type found in writer files. A bit more research and I have some working code. It’s not pretty but it finds the thing. I’m open to any alternative methods.
sHeadingLink = "not_found"
oHeadings = oDoc.Links.GetByName("Headings").getElementNames
For each s in oHeadings
If (InStr(s, oNameCell.String) > 0) Then
sHeadingLink = s
Exit For
End If
Next
*** EDIT ***
Here is a more complete copy of the code I’m running. The above is a bit misleading as it is only a fragment. But using the below code and the sample file in the original will let you see all the stuff happening here.
Function foCreateNewDoc(intWhich)
sURLs = Array("swriter", "scalc", "sdraw", "smath", "simpress")
sURL = "private:factory/" & sURLs(intWhich)
foCreateNewDoc = StarDesktop.LoadComponentFromUrl(sURL, "_blank", 0, Array())
End Function
Function foGetOrOpenFile(strPath, strFile)
Dim args()
' Get a list of open LO files. If open, return the wanted file, otherwise open it and return that...WRG
oComps = StarDesktop.Components
oCompsEnum = oComps.createEnumeration()
boolFileFound = False
' Search open files for the one we need...WRG
Do While oCompsEnum.hasMoreElements()
oComp = oCompsEnum.nextElement()
If (StrComp(oComp.Title, strFile, 0) = 0) Then
' File found, exit loop...WRG
boolFileFound = True
oDoc = oComp
Exit Do
End If
Loop
If Not boolFileFound Then
' because file is not already open, open it...WRG
strDocPath = strPath + strFile
oDoc = StarDesktop.loadComponentFromURL(ConvertToUrl(strDocPath), "_default", 0, args())
End If
' Return file...WRG
foGetOrOpenFile = oDoc
End Function
Function foGetCalcSheet(strName, oCalcFile, boolDeleteExisting)
if oCalcFile.Sheets.hasByName(strName) And boolDeleteExisting Then
oCalcFile.Sheets.removeByName(strName)
End If
oCalcFile.Sheets.insertNewByName(strName, oCalcFile.Sheets.Count)
'Return the sheet...WRG
foGetCalcSheet = oCalcFile.Sheets.getByName(strName)
End Function
Function fsNewLocateHeadingLinkAddress(oDoc, oHeaderCell)
' Proposed by sokol92, I made minor adjustments for my testing...WRG
Dim sLink As String, sHeadingLink As String, sHeadName As String, s As String
Dim oLink As Object
sHeadingURL = "not_found"
sHeadName= oHeaderCell.String
For Each sLink In oDoc.Links.ElementNames
oLink=oDoc.Links.getByName(sLink)
For Each s in oLink.ElementNames
If Right(s, 8)<>"|outline" Then
Exit For
End If
If s=sHeadName & "|outline" Then
sHeadingURL = s
Exit For
End If
Next s
Next sLink
fsNewLocateHeadingLinkAddress = sHeadingURL
End Function
Function fsLocateHeadingLinkAddress(oDoc, oHeaderCell)
'oHeaderCell has text that is a heading. In the document, there will be links to that heading.
' So, save the heading URL for later use in recreating those links...WRG
sHeadingURL = "not_found"
'The best we have is a partial match, what is in oHeaderCell.String is just the name of the skill. Adding that to "|outline" gives
' us more but still lacks the counting prependings, like 11.3.2 which would be because the 11th heading 1, the 3rd heading 2,
' and the 2nd heading 3 where counted. Without counting all that out, which we don't do because enough time has been given
' to this problem, the best we have is a partial name and hence there is still a window of failure...WRG
sPartialHeadingName = oHeaderCell.String & "|outline"
oHeadings = oDoc.Links.GetByName("Headings").getElementNames()
For each s in oHeadings
'Best case, the InStr returns 1, this means the match was perfect. The best I expect to see with my data is something
' In the range of 10 to 12, the space I expect the counts to take up.
If (InStr(s, sPartialHeadingName) > 0 and InStr(s, sPartialHeadingName) < 12) Then
sHeadingURL = s
Exit For
End If
Next
fsLocateHeadingLinkAddress = sHeadingURL
End Function
Function fiProcessSkillTable (oGuideFile, oLeadsToFile, sSkillTable, iStep, oTempSheet, iTSIndex)
' Pull the skill table apart and move that data to the calc sheet...WRG
oSkillTable = oGuideFile.TextTables.getByName(sSkillTable)
iRowKnt = oSkillTable.Rows.Count - 1
r = iTSIndex 'Tracks what row we are in on oTempSheet...WRG
'The skill table uses multiple rows and cols to display the stat block of a skill, hence having a For using Step...WRG
For mr = 0 to iRowKnt Step iStep
'Cells of interest within the skill's stat block, set names of these cells...WRG
strNameCell = "A" & (mr+1)
strRankCell = "B" & (mr+1)
strTypeCell = "C" & (mr+1)
strERBCell = "D" & (mr+1)
strDescriptionCell = "B" & (mr+2)
strPrerequisiteListCell = "C" & (mr+3)
strWithAAListCell = "C" & (mr+4) 'Not used when iStep is less than 6...WRG
strWithAAAListCell = "C" & (mr+5) 'Not used when iStep is less than 6...WRG
'The last row is a blank spacer row, so nothing there is needed...WRG
'Using above names, get cells from the writer doc's skill table...WRG
oNameCell = oSkillTable.getCellByName(strNameCell)
oRankCell = oSkillTable.getCellByName(strRankCell)
oTypeCell = oSkillTable.getCellByName(strTypeCell)
oERBCell = oSkillTable.getCellByName(strERBCell)
oDescCell = oSkillTable.getCellByName(strDescriptionCell)
oPreListCell = oSkillTable.getCellByName(strPrerequisiteListCell)
oAAListCell = oSkillTable.getCellByName(strWithAAListCell) 'Not used when iStep is less than 6...WRG
oAAAListCell = oSkillTable.getCellByName(strWithAAAListCell) 'Not used when iStep is less than 6...WRG
'sHeadingURL = fsLocateHeadingLinkAddress(oGuideFile, oNameCell)
sHeadingURL = fsNewLocateHeadingLinkAddress(oGuideFile, oNameCell)
'Move these cells to the calc sheet...WRG
oTempSheet.getCellByPosition(0,r).setString(oNameCell.String)
oTempSheet.getCellByPosition(1,r).setString(sHeadingURL)
oTempSheet.getCellByPosition(2,r).setString(Mid(oRankCell.String, 7)) 'Cut out "Rank: "...WRG
oTempSheet.getCellByPosition(3,r).setString(oTypeCell.String)
oTempSheet.getCellByPosition(4,r).setString(Mid(oERBCell.String, 6)) 'Cut out "ERB: "...WRG
oTempTargetCell = oTempSheet.getCellByPosition(5, r)
iURLknt = 1 'The description may have one or more URLs in it, keep count in iURLknt...WRG
'oDescCell has complex data. In addition to the typical "about blurb" it could have a sub table and/or links to other
' secitions of the doc. So we will step through the cell's content by object. Most of this should be paragraph
' objects, some of which will be links. There will be a few sub tables as well. Those are simple tables and will be
' stored, each in their own sheet. These sheets are named by the table name so the blower can reverse all this...WRG
For Each o In oDescCell
If o.supportsService("com.sun.star.text.TextTable") Then
'Add placeholder to the description...WRG
oTempTargetCell.setString(oTempTargetCell.String+ "***"+o.TableName+"***")
'Add data sheet so we can copy table values there...WRG
With oLeadsToFile.Sheets
If .hasByName(o.TableName) Then
.removeByName(o.TableName)
End If
.insertNewByName(o.TableName, .Count)
End With
'Get ref to the new sheet...WRG
oSubSheet = oLeadsToFile.Sheets(oLeadsToFile.Sheets.Count-1)
'Get ref to the sub-table...WRG
oSubTable = oGuideFile.TextTables.getByName(o.TableName)
'Get sub-table bounds...WRG
intRowKnt = oSubTable.Rows.Count - 1
intColKnt = oSubTable.Columns.Count - 1
'Copy the cells to the new sheet...WRG
For r2 = 0 To intRowKnt
For c2 = 0 To intColKnt
oSubSheet.getCellByPosition(c2,r2).setString(oSubTable.getCellByPosition(c2,r2).String)
Next ' For c2 = 0 To intColKnt
Next ' For r2 = 0 To intRowKnt
'Set col width on this sheet...WRG
oColumns = oSubSheet.getColumns()
For c3 = 0 To intColKnt
oColumns.getByIndex(c3).OptimalWidth = True
Next ' For c3 = 0 To intColKnt
ElseIf o.supportsService("com.sun.star.text.Paragraph") Then
oTempTargetCell.setString(oTempTargetCell.String+o.String)
'Check for this paragraph object being a URL...WRG
For Each o2 In o
sUrl = o2.HyperlinkURL
If sUrl <> "" Then
'Add URL to the end of row...WRG
oTempSheet.getCellByPosition(8+iURLknt,r).setString(sUrl)
'Add to the URL counter for this description...WRG
iURLknt = iURLknt + 1
End If ' End If sUrl <> "" Then
Next ' For Each o2 In o
Else
MsgBox("skipping the unknown thing")
End If ' End If o.supportsService("com.sun.star.text.TextTable") Then
Next ' For Each o In oDescCell
'Finish col 5 by cutting a bit of beginning text that isn't needed...WRG
oTempSheet.getCellByPosition(5,r).setString(Mid(oTempTargetCell.String, 19)) 'Cut out "Common Knowledge: "...WRG
oTempSheet.getCellByPosition(6,r).setString(oPreListCell.String)
if (iStep = 6) Then
'Only used when iStep is 6...WRG
oTempSheet.getCellByPosition(7,r).setString(oAAListCell.String)
oTempSheet.getCellByPosition(8,r).setString(oAAAListCell.String)
End If 'End if (iStep = 6) Then
'Set some cell props, likely only use about 12 cols for this data...WRG
For x = 0 to 12
oTempSheet.getCellByPosition(x,r).VertJustify = com.sun.star.table.CellVertJustify.TOP
if x > 3 Then
oTempSheet.getCellByPosition(x,r).IsTextWrapped = True
End If
Next
r = r + 1 'Advancing row for oTempSheet...WRG
Next ' End For mr = 0 to iRowKnt Step iStep
'Returns the index of the next blank line of the calc sheet...WRG
fiProcessSkillTable = r
End Function
Sub MasterDataSucker
REM Suck writer doc info into calc sheets...WRG
Dim strTempSheetName As String
'Open calc file...WRG
oLeadsToFile = foCreateNewDoc(1)
'Make a temp sheet to work with, rename later to show we are done...WRG
strTempSheetName = "BuildTemp"
'If the temp sheet exist, delete it and make a fresh one...WRG
oTempSheet = foGetCalcSheet(strTempSheetName, oLeadsToFile, true)
oLeadsToFile.CurrentController.setActiveSheet(oTempSheet)
'Set col width on the temp sheet...WRG
oColumns = oTempSheet.getColumns()
'Can't use optimal here, the data is too big. I don't want 22 inch cols...WRG
With oColumns
.getByName("A").Width = 4800
.getByName("B").Width = 5800
.getByName("C").Width = 2900
.getByName("D").Width = 2250
.getByName("E").Width = 2250
.getByName("F").Width = 20000
.getByName("G").Width = 8000
.getByName("H").Width = 8000
.getByName("I").Width = 8000
.getByName("J").Width = 5800
.getByName("k").Width = 5800
.getByName("l").Width = 5800
End With ' End oColumns
strGuideFile = "MT script test doc6.odt"
strGuidePath = "C:\Users\WRG\Documents\projects\Magickal Thinking\Playtesting\"
oGuideFile = foGetOrOpenFile(strGuidePath, strGuideFile)
'Process common skill table...WRG
iTSIndex = fiProcessSkillTable(oGuideFile, oLeadsToFile, "CommonSkills", 6, oTempSheet, 0)
'Process enchanted skill table...WRG
iTSIndex = fiProcessSkillTable(oGuideFile, oLeadsToFile, "EnchantedSkills", 4, oTempSheet, iTSIndex)
'Process transcendent skill table...WRG
iTSIndex = fiProcessSkillTable(oGuideFile, oLeadsToFile, "TranscendentSkills", 4, oTempSheet, iTSIndex)
'Rename to Master Data. This shows me the macro is done processing...WRG
sFinishedTabName = "New Master Data" 'Change name later...WRG
With oLeadsToFile.Sheets
If .hasByName(sFinishedTabName) Then
.removeByName(sFinishedTabName)
End If
End With 'End oLeadsToFile.Sheets
oTempSheet.Name = sFinishedTabName
End Sub
Sub MasterDataBlower
REM Blows calc sheet data back into writer doc tables...WRG
REM this is a to-do-reminder
End Sub
Sub Main
'Testing stuff here
MasterDataSucker
'MasterDataBlower
End Sub
I’m afraid this will only work with locales where Headings are translated as Headings. 
Built-in styles have the same English name in all UI languages. Each one has a property “DisplayName” which reflects the localized name.
Sorry, I confused styles with links.
We can try this workaround:
Sub test
Dim sLink As String, sHeadingLink As String, sHeadName As String, s As String
Dim oLink As Object
sHeadingLink = "not_found"
sHeadName="1.2.3.Enchanted Skill C"
For Each sLink In ThisComponent.Links.ElementNames
oLink=ThisComponent.Links.getByName(sLink)
For Each s in oLink.ElementNames
If Right(s, 8)<>"|outline" Then
Exit For
End If
If s=sHeadName & "|outline" Then
sHeadingLink = s
Exit For
End If
Next s
Next sLink
End Sub
If s=sHeadName & "|outline" Then
This only works on a full match, with my data, that will not happen. So I use Instr, because a partial match is the best I can get atm. Adding “|outline” to the name will help, so I am adding that.
sHeadName="1.2.3.Enchanted Skill C"
What would be there in my dataset is just “Enchanted Skill C” without the prepending counters. Not having that bit is why I have to search for it in Links in the first place.
Of course, a partial match with Instr has inherent issues of false positives but I have to live with that. Again, if I had the whole thing, I wouldn’t need to do the search at all. I could just validate it’s there and move on.
As far as issues with localization, I’m afraid that’s an area I don’t know much about.