Sub archMark8 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 As Object Dim oAnchor1 As Object Dim oAnchor2 As Object Dim oAnchor1Name As String Dim oAnchor2Name As String 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 objectsCount < 2 OR objectsCount > 2 Then MsgBox "Нужно выделить два объекта" 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 Dim description As String description = "Запустить восстановление разрывов страниц?" If NOT confirm(description) Then Exit Sub EndIf 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 MsgBox "Восстановление разрывов страниц завершено." 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 description As String description = "Запустить восстановление сносок из текста?" If NOT confirm(description) Then Exit Sub EndIf 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 MsgBox "Восстановление сносок завершено." 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 Dim oDialog Sub onSelectMenuItem(oEvent) oDialog.endExecute() oDialog.model.Tag = oEvent.ActionCommand End Sub Sub replaceParaStyle dim oldStyleName As String dim oldStyle As Object dim newStyleName As String dim paragraphStyles As Object dim userInput As Integer Dim listBox As Object Dim paraStyle As Object Dim oViewCursor As Object Dim enum1 As Object Dim oTextCursor As Object oStyles = ThisComponent.StyleFamilies paraStyles = oStyles.getByName(oStyles.elementNames(1)) oViewCursor = ThisComponent.CurrentController.getViewCursor() oldStyleName = oViewCursor.ParaStyleName paraStyleNames = paraStyles.ElementNames Dim displayParaStyleNames(Ubound(paraStyleNames)) Dim sortedDPSN(Ubound(paraStyleNames)) displayParaStyleNames = paraStyleNames Redim Preserve displayParaStyleNames(Ubound(paraStyleNames)) For i = LBound(displayParaStyleNames) To Ubound(displayParaStyleNames) paraStyle = paraStyles.getByName(displayParaStyleNames(i)) displayParaStyleNames(i) = paraStyle.displayName Next i sortedDPSN = displayParaStyleNames Redim Preserve sortedDPSN(Ubound(paraStyleNames)) subShellSort(sortedDPSN) DialogLibraries.LoadLibrary("ePublishing") oDialog = CreateUnoDialog( DialogLibraries.ePublishing.replaceParaStyle ) listBox = oDialog.getControl("ListBox1") listBox.addItems(sortedDPSN , 0) oDialog.Execute() newStyleName = oDialog.model.Tag If newStyleName="0" or newStyleName="" Then Exit sub EndIf foundIndex = getIndex(displayParaStyleNames, newStyleName) 'set style system name instead of display name newStyleName = paraStyleNames(foundIndex) If newStyleName = oldStyleName Then MsgBox "Стили не различаются" Exit sub EndIf If oldStyleName <> "" Then oldStyle = paraStyles.getByName(oldStyleName) If NOT oldStyle.isUserDefined Then MsgBox "Невозвожно заменять встроенные стили" Exit sub EndIf oldStyle.ParentStyle = newStyleName paraStyles.removeByName(oldStyleName) EndIf oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) enum1 = oTextCursor.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then If enum1Element.ParaStyleName <> newStyleName Then oldStyle = paraStyles.getByName(enum1Element.ParaStyleName) oldStyle.ParentStyle = newStyleName paraStyles.removeByName(enum1Element.ParaStyleName) EndIf EndIf Wend End Sub function getIndex(a, v) id = 0 nRight = uBound(a) nLen = len(v) while id <= nRight if a(id) = v then getIndex = id exit Function Else id = id + 1 end if wend getIndex = -1 end function sub subShellSort(mArray) dim n as integer, h as integer, i as integer, j as integer, t as string, Ub as integer, LB as Integer Lb = lBound(mArray) Ub = uBound(mArray) ' compute largest increment n = Ub - Lb + 1 h = 1 if n > 14 then do while h < n h = 3 * h + 1 loop h = h \ 3 h = h \ 3 end if do while h > 0 for i = Lb + h to Ub t = mArray(i) for j = i - h to Lb step -h if strComp(mArray(j), t, 0) < 1 then exit for mArray(j + h) = mArray(j) next j mArray(j + h) = t next i h = h \ 3 loop end sub