diff --git a/Addons.xcu b/Addons.xcu
index 372c60e..b5870ca 100644
--- a/Addons.xcu
+++ b/Addons.xcu
@@ -132,6 +132,23 @@
+
+
+ com.sun.star.text.TextDocument,com.sun.star.text.WebDocument
+
+
+ Create links in Table Of Contents
+ Создать в ссылки в оглавлении
+
+
+ macro:///ePublishing.TOCLinks.makeOutlineLinks
+
+
+ _self
+
+
+
+
diff --git a/description.xml b/description.xml
index 33b941b..0a8f8b2 100644
--- a/description.xml
+++ b/description.xml
@@ -3,7 +3,7 @@
xmlns:dep="http://openoffice.org/extensions/description/2006"
xmlns:xlink="http://www.w3.org/1999/xlink">
-
+
Инструменты для создания электронных изданий
diff --git a/ePublishing/TOCLinks.xba b/ePublishing/TOCLinks.xba
new file mode 100644
index 0000000..80d1aac
--- /dev/null
+++ b/ePublishing/TOCLinks.xba
@@ -0,0 +1,148 @@
+
+
+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) <> -1 AND Ubound(outline) <> -1 Then
+ If (Ubound(outline) + 1) MOD (Ubound(heading) + 1 ) = 0 Then
+ For i = 0 To (Ubound(outline))
+ oAnchor2Name = "Оглавление " + level + "." + (i Mod (Ubound(heading) + 1))
+ If i <= Ubound(heading) Then
+ createAnchor(heading(i Mod (Ubound(heading) + 1)),oAnchor2Name)
+ EndIf
+ createLink(outline(i),"",oAnchor2Name)
+ Next i
+ Else
+ MsgBox ("Число Оглавлений "+ level +" уровня ("+(Ubound(outline)+1) +") не кратно числу Заголовоков " + level + " уровня (" + (Ubound(heading)+1) + ")"
+ EndIf
+ ElseIf Ubound(outline) = -1 Then
+
+ 'MsgBox ("Не могу сделать ссылки в оглавлении. Оглавлений "+ level + " уровня не найдено.")
+ ElseIf Ubound(heading) = -1 Then
+ MsgBox ("Не могу сделать ссылки в оглавлении. Заголовоков "+ level + " уровня не найдено.")
+ 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("com.sun.star.text.Paragraph") Then
+ If enum1Element.OutlineLevel = curNum Then
+ addToArray(headingPar(),enum1Element)
+ EndIf
+
+ ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") 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("com.sun.star.text.Paragraph") 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 = "Contents " + curNum
+ enum1 = ThisComponent.Text.createEnumeration
+ While enum1.hasMoreElements
+ enum1Element = enum1.nextElement
+ If enum1Element.supportsService("com.sun.star.text.Paragraph") Then
+ If enum1Element.ParaStyleName = parName Then
+ addToArray(par(),enum1Element)
+ EndIf
+
+ ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") 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("com.sun.star.text.Paragraph") 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 > 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
+
+
\ No newline at end of file
diff --git a/ePublishing/script.xlb b/ePublishing/script.xlb
index 31ded4f..ff57bf7 100644
--- a/ePublishing/script.xlb
+++ b/ePublishing/script.xlb
@@ -5,4 +5,5 @@
+
\ No newline at end of file