Sub archMark2 End Sub Sub resetNotesStyle Dim oDescriptor 'The search descriptor dim dispatcher as Object dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim document as Object document = ThisComponent.CurrentController.Frame Dim oViewCursor As Object 'View cursor oViewCursor = ThisComponent.CurrentController.getViewCursor() allNotes= thisComponent.FootNotes for x = 0 to allNotes.Count -1 aNote = allNotes.getByIndex(x) aNote.Anchor.CharStyleName="Footnote anchor" oEnum = aNote.Text.createEnumeration() Do While oEnum.hasMoreElements() oCurPar = oEnum.nextElement() oCurPar.ParaStyleName = "Footnote" Loop Next End Sub Sub createBidirectLink Dim oSelections 'Contains all of the selections Dim oAnchor1 Dim oAnchor2 If IsNull(ThisComponent) Then MsgBox "Ничего не выбрано" Exit Sub End If oSelections = ThisComponent.getCurrentSelection() If IsNull(oSelections) Then MsgBox "Ничего не выбрано" Exit Sub End If objectsCount = oSelections.getCount() - 1 If oSelections.getCount() = 0 Then MsgBox "Ничего не выбрано" Exit Sub End If If oSelections.getCount() <= 2 Then MsgBox "Нужно выделить два объекта, а не " + objectsCount Exit Sub End If If oSelections.getCount() > 3 Then MsgBox "Нужно выделить только два объекта, а не " + objectsCount Exit Sub End If oAnchor1 = oSelections.getByIndex(1) oAnchor2 = oSelections.getByIndex(2) oAnchor1Name = RND_String() oAnchor2Name = RND_String() createAnchor(oAnchor1,oAnchor1Name) createAnchor(oAnchor2,oAnchor2Name) createLink(oAnchor1,oAnchor1.String,oAnchor2Name) createLink(oAnchor2,oAnchor2.String,oAnchor1Name) End Sub Sub createAnchor(targetRange as Object,anchorName as String) dim oViewCursor as object dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.gotoRange(targetRange,false) dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "Bookmark" args1(0).Value = anchorName dispatcher.executeDispatch(document, ".uno:InsertBookmark", "", 0, args1()) End Sub Sub createLink(targetRange as Object,linkName as String,linkURL as String) dim oViewCursor as object dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.gotoRange(targetRange,false) dim args2(4) as new com.sun.star.beans.PropertyValue args2(0).Name = "Hyperlink.Text" args2(0).Value = linkName args2(1).Name = "Hyperlink.URL" args2(1).Value = "#"+linkURL args2(2).Name = "Hyperlink.Target" args2(2).Value = "" args2(3).Name = "Hyperlink.Name" args2(3).Value = linkName args2(4).Name = "Hyperlink.Type" args2(4).Value = 1 dispatcher.executeDispatch(document, ".uno:SetHyperlink", "", 0, args2()) End Sub Function RND_String Dim OutputString As String Dim TempString As String Dim i as Long OutputString="" randomize for i = 1 to 20 Select Case i Case 5, 8, 11, 14 OutputString=OutputString+"-" Case Else TempString=Hex(int(rnd*256)) if len(TempString)<2 then TempString=TempString+"0" OutputString=OutputString+TempString End Select next i RND_String = OutputString End Function sub convertIndesignPageBreaks document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") oViewCursor = thisComponent.getCurrentController.getViewCursor oViewCursor.jumpToFirstPage Dim args(0) as new com.sun.star.beans.PropertyValue rem Turn off tracking changes to prevent infinite args(0).Name = "TrackChanges" args(0).Value = false dispatcher.executeDispatch(document, ".uno:TrackChanges", "", 0, args()) Dim oSearch Dim oTextCursor Dim lineIndent Dim firstLowercase As Boolean Dim charNum As Long Dim character As String firstLowercase = false oSearch = ThisComponent.createSearchDescriptor() oSearch.SearchString = "---XYXYX---" oSearch.SearchRegularExpression=True oSearch.searchAll=True oFound = ThisComponent.findFirst(oSearch) Do While Not IsNull(oFound) oTextCursor = oFound.Text.createTextCursor() oTextCursor.gotoRange(oFound,false) oTextCursor.gotoStartOfParagraph(false) oTextCursor.gotoEndOfParagraph(true) oTextCursor.goRight(1,true) oTextCursor.String = "" oTextCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE 'check first character oTextCursor.goRight(1,true) If (isLowerCase(oTextCursor.getString())) Then oTextCursor.ParaFirstLineIndent = 0 firstLowercase = true End If 'check last character oTextCursor.goLeft(2,false) oTextCursor.goLeft(1,true) character = oTextCursor.getString() If (character = " ") Then oTextCursor.String="" adjustLastLine(oTextCursor) adjustFirstLine(oTextCursor) EndIf If (isLowerCase(character)) Then If firstLowercase Then oTextCursor.collapseToEnd() oTextCursor.setString("-") oTextCursor.collapseToEnd() adjustLastLine(oTextCursor) adjustFirstLine(oTextCursor) EndIf End If oFound = ThisComponent.findNext(oFound.End, oSearch) Loop end Sub Sub adjustLastLine(oTextCursor) oTextCursor.ParaAdjust = 2 oTextCursor.ParaLastLineAdjust = 2 balancePara(oTextCursor) End Sub Sub adjustFirstLine(oTextCursor) oTextCursor.goRight(1,false) oTextCursor.ParaFirstLineIndent = 0 End Sub Function isLowerCase(character) If (character = "") Then charNum = ASC(""+0) Else charNum = ASC(character) End If If ((charNum > 1071 AND charNum < 1104) Or (charNum > 60 AND charNum < 123)) Then isLowerCase = true Exit Function EndIf isLowerCase = false End Function Sub balancePara(Optional targetPara As Object) ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim oViewCursor As Object Dim oTextCursor As Object Dim oPara As Object Dim oParaStart As Object Dim oParaEnd As Object Dim paraLen As Integer Dim lineCount As Integer Dim initialLineCount As Integer Dim lineLen As Integer Dim mathExpect As Integer Dim minLastLineLength As Integer paraLen = 0 lineLen = 0 minLastLineLength = 0 initialLineCount = 0 oViewCursor = ThisComponent.CurrentController.getViewCursor() If NOT IsMissing(targetPara) Then oViewCursor.goToRange(targetPara, false) EndIf oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oPara = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'Go to start of para oTextCursor.gotoStartOfParagraph(false) 'Get start position oParaStart = oTextCursor.getStart() 'Go to end of para oTextCursor.gotoEndOfParagraph(false) 'Get end position oParaEnd = oTextCursor.getEnd() 'return Text cursor to start oTextCursor.goToRange(oParaStart,false) 'oPara is full para cursor oPara.goToRange(oParaStart,false) oPara.goToRange(oParaEnd,true) Do 'Not first iteration If minLastLineLength <> 0 Then If oPara.CharKerning < 30 Then If(IsEmpty(oPara.CharKerning)) Then oPara.CharKerning = 0 Else oPara.CharKerning = oPara.CharKerning + 2 End If Else 'Failed to balance para Exit Sub EndIf EndIf oViewCursor.goToRange(oParaStart,false) oTextCursor.goToRange(oParaStart,false) lineCount = 0 While NOT oTextCursor.isEndOfParagraph() oViewCursor.gotoEndOfLine(true) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) lineLen = Len(oTextCursor.getString()) paraLen = paraLen + lineLen lineCount = lineCount + 1 oViewCursor.collapseToEnd() Wend 'set initial line count If initialLineCount = 0 Then initialLineCount = lineCount ElseIf lineCount > initialLineCount Then 'Undo last iteration as line overflow happened. 'And exit If(IsEmpty(oPara.CharKerning)) Then oPara.CharKerning = 0 Else oPara.CharKerning = oPara.CharKerning - 2 End If Exit sub EndIf mathExpect = paraLen / lineCount minLastLineLength = mathExpect * 0.9 Loop Until minLastLineLength < lineLen End Sub Sub convertBookmarksToFootnotes() Dim bookmarks as Object Dim bookmarkName as String Dim strStart As Integer Dim linkPrefix As String Dim backLinkSuffix As String Dim backwardLink As String Dim forwardLink As String Dim forward As Object Dim backward As Object linkPrefix = "footnote-" backLinkSuffix = "-backlink" bookmarkName = ThisComponent.Links.ElementNames(6) bookmarks = ThisComponent.Links.getByName(bookmarkName) ' Mri bookmarks bookmarkNames = bookmarks.getElementNames() For i = LBound(bookmarkNames) To Ubound(bookmarkNames) bookmarkName = bookmarkNames(i) If InStr(bookmarkName, linkPrefix) = 1 Then forwardLink = "" backwardLink = "" If InStr(bookmarkName, backLinkSuffix) > 0 Then forwardLink = Left(bookmarkName,Len(bookmarkName) - Len(backLinkSuffix)) backwardLink = bookmarkName Else forwardLink = bookmarkName backwardLink = bookmarkName + backLinkSuffix EndIf convertLinkToFootnote(forwardLink,backwardLink) EndIf Next i resetNotesStyle End Sub Sub convertLinkToFootnote(forwardLink,backwardLink) Dim bookMarkName As String bookmarkName = ThisComponent.Links.ElementNames(6) Dim bookmarks As Object bookmarks = ThisComponent.Links.getByName(bookmarkName) Dim forward As Object Dim backward As Object Dim oViewCursor As Object Dim footNoteSign As String oViewCursor = ThisComponent.CurrentController.getViewCursor() Dim oTextCursor As Object If NOT bookmarks.hasByName(forwardLink) OR NOT bookmarks.hasByName(backwardLink) Then exit sub 'If msgbox( "NO SuCH LINK", 36 ) = 6 Then Stop EndIf forward = bookmarks.getByName(forwardLink) backward = bookmarks.getByName(backwardLink) oViewCursor.goToRange(forward.Anchor,false) footNoteSign = oViewCursor.getString() backspace backspace SendRM oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.gotoEndOfParagraph(false) oTextCursor.gotoStartOfParagraph(true) oViewCursor.goToRange(oTextCursor,true) unoCut() SendRM oViewCursor.goToRange(backward.Anchor,false) backspace createFootnote unoPaste() oViewCursor.getText.setLabel(footNoteSign) forward.dispose() backward.dispose() End sub sub unoCut dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Cut", "", 0, Array()) end sub sub unoPaste dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) end sub sub createFootnote dim document as object dim dispatcher as object rem ---------------------------------------------------------------------- rem get access to the document document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:InsertFootnote", "", 0, Array()) end Sub