Added TOC Links macro

This commit is contained in:
Georgy Litvinov 2020-03-16 12:03:48 +01:00
parent 6476a01813
commit fd5384612c
4 changed files with 167 additions and 1 deletions

View file

@ -132,6 +132,23 @@
</prop> </prop>
</node> </node>
<node oor:name="TOCLinks" oor:op="replace">
<prop oor:name="Context" oor:type="xs:string">
<value>com.sun.star.text.TextDocument,com.sun.star.text.WebDocument</value>
</prop>
<prop oor:name="Title" oor:type="xs:string">
<value xml:lang="en">Create links in Table Of Contents</value>
<value xml:lang="ru">Создать в ссылки в оглавлении</value>
</prop>
<prop oor:name="URL" oor:type="xs:string">
<value>macro:///ePublishing.TOCLinks.makeOutlineLinks</value>
</prop>
<prop oor:name="Target" oor:type="xs:string">
<value>_self</value>
</prop>
</node>
</node> </node>

View file

@ -3,7 +3,7 @@
xmlns:dep="http://openoffice.org/extensions/description/2006" xmlns:dep="http://openoffice.org/extensions/description/2006"
xmlns:xlink="http://www.w3.org/1999/xlink"> xmlns:xlink="http://www.w3.org/1999/xlink">
<identifier value="pro.litvinovg.epublishing" /> <identifier value="pro.litvinovg.epublishing" />
<version value="0.1.4" /> <version value="0.1.5" />
<platform value="all" /> <platform value="all" />
<display-name> <display-name>
<name lang="ru">Инструменты для создания электронных изданий</name> <name lang="ru">Инструменты для создания электронных изданий</name>

148
ePublishing/TOCLinks.xba Normal file
View file

@ -0,0 +1,148 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="TOCLinks" script:language="StarBasic" script:moduleType="normal">Sub markTOC2
End Sub
Sub makeOutlineLinks
For i = 1 To 10
makeLinksWithLevel(i)
Next i
End Sub
Sub makeLinksWithLevel(level)
Dim heading() As Object
Dim outline() As Object
Dim oAnchor1Name As String
Dim oAnchor2Name As String
Dim i As Integer
heading = getHeadingWithLevel(level)
outline = getOutlineWithLevel(level)
If Ubound(heading) &lt;&gt; -1 AND Ubound(outline) &lt;&gt; -1 Then
If (Ubound(outline) + 1) MOD (Ubound(heading) + 1 ) = 0 Then
For i = 0 To (Ubound(outline))
oAnchor2Name = &quot;Оглавление &quot; + level + &quot;.&quot; + (i Mod (Ubound(heading) + 1))
If i &lt;= Ubound(heading) Then
createAnchor(heading(i Mod (Ubound(heading) + 1)),oAnchor2Name)
EndIf
createLink(outline(i),&quot;&quot;,oAnchor2Name)
Next i
Else
MsgBox (&quot;Число Оглавлений &quot;+ level +&quot; уровня (&quot;+(Ubound(outline)+1) +&quot;) не кратно числу Заголовоков &quot; + level + &quot; уровня (&quot; + (Ubound(heading)+1) + &quot;)&quot;
EndIf
ElseIf Ubound(outline) = -1 Then
&apos;MsgBox (&quot;Не могу сделать ссылки в оглавлении. Оглавлений &quot;+ level + &quot; уровня не найдено.&quot;)
ElseIf Ubound(heading) = -1 Then
MsgBox (&quot;Не могу сделать ссылки в оглавлении. Заголовоков &quot;+ level + &quot; уровня не найдено.&quot;)
EndIf
End Sub
Function getHeadingWithLevel(curNum)
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellEnum As Object
Dim cellEnum2 As Object
Dim headingPar() As Object
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If enum1Element.OutlineLevel = curNum Then
addToArray(headingPar(),enum1Element)
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellEnum = cell.getText().createEnumeration()
While cellEnum.hasMoreElements
cellEnumElement = cellEnum.nextElement
If cellEnumElement.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If cellEnumElement.OutlineLevel = curNum Then
addToArray(headingPar(),cellEnumElement)
EndIf
EndIf
Wend
Next i
EndIf
Wend
getHeadingWithLevel = headingPar()
End Function
Function getOutlineWithLevel(curNum)
Dim enum1Element As Object
Dim enum1 As Object
Dim enum2 As Object
Dim thisPortion As Object
Dim footnoteText As Object
Dim label As String
Dim labelNum As Integer
Dim i As Integer
Dim count As Integer
Dim cell As Object
Dim cellEnum As Object
Dim cellEnum2 As Object
Dim par() As Object
Dim parName As String
parName = &quot;Contents &quot; + curNum
enum1 = ThisComponent.Text.createEnumeration
While enum1.hasMoreElements
enum1Element = enum1.nextElement
If enum1Element.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If enum1Element.ParaStyleName = parName Then
addToArray(par(),enum1Element)
EndIf
ElseIf enum1Element.supportsService(&quot;com.sun.star.text.TextTable&quot;) Then
cellNames = enum1Element.cellNames
For i = LBound(cellNames) To Ubound(cellNames)
cell = enum1Element.getCellByName(cellNames(i))
cellEnum = cell.getText().createEnumeration()
While cellEnum.hasMoreElements
cellEnumElement = cellEnum.nextElement
If cellEnumElement.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
If cellEnumElement.ParaStyleName = parName Then
addToArray(par(),cellEnumElement)
EndIf
EndIf
Wend
Next i
Else
Mri enum1Element
EndIf
Wend
getOutlineWithLevel = par()
End Function
Sub addToArray(xArray(),vNextElement)
Dim iUB%,iLB%
iLB = lBound(xArray())
iUB = uBound(xArray())
If iLB &gt; iUB then
iUB = iLB
redim xArray(iLB To iUB)
Else
iUB = iUB +1
redim preserve xArray(iLB To iUB)
Endif
xArray(iUB) = vNextElement
End Sub
</script:module>

View file

@ -5,4 +5,5 @@
<library:element library:name="Books"/> <library:element library:name="Books"/>
<library:element library:name="journals"/> <library:element library:name="journals"/>
<library:element library:name="Footnotes"/> <library:element library:name="Footnotes"/>
<library:element library:name="TOCLinks"/>
</library:library> </library:library>