Sub archMark10 End Sub Sub resetNotesStyle Dim oDescriptor As Object Dim dispatcher As Object Dim x As Integer Dim oViewCursor As Object Dim document As Object Dim allNotes As Object Dim aNote As Object Dim oEnum As Object Dim oCurPar As Object dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") document = ThisComponent.CurrentController.Frame 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 getTranslation("bidirectLinkSuggestion") Exit Sub End If oSelections = ThisComponent.getCurrentSelection() If IsNull(oSelections) Then MsgBox getTranslation("bidirectLinkSuggestion") Exit Sub End If objectsCount = oSelections.getCount() - 1 If objectsCount < 2 OR objectsCount > 2 Then MsgBox getTranslation("bidirectLinkSuggestion") 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" EndIf OutputString=OutputString+TempString End Select next i RND_String = OutputString End Function sub convertIndesignPageBreaks Dim description As String description = getTranslation("convertIndesignPageBreaksConfirmation") If NOT confirm(description) Then Exit Sub EndIf Dim document As Object document = ThisComponent.CurrentController.Frame Dim dispatcher As Object dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") Dim oViewCursor As Object 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 As Object Dim oTextCursor As Object Dim firstLowercase As Boolean Dim charNum As Long Dim character As String Dim oFound As Object 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 getTranslation("convertIndesignPageBreaksFinish") end Sub Sub adjustLastLine(oTextCursor As Object) oTextCursor.ParaAdjust = 2 oTextCursor.ParaLastLineAdjust = 2 balancePara(oTextCursor) End Sub Sub adjustFirstLine(oTextCursor As Object) oTextCursor.goRight(1,false) oTextCursor.ParaFirstLineIndent = 0 End Sub Function isLowerCase(character As String) As Boolean Dim charNum As Integer 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(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() oViewCursor.goToRange(targetPara, false) 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 = getTranslation("convertIndesignFoonotesConfirmation") If NOT confirm(description) Then Exit Sub EndIf Dim bookmarks as Object Dim bookmarkName as String Dim bookmarkNames() 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" Dim i As Integer bookmarkName = ThisComponent.Links.ElementNames(6) bookmarks = ThisComponent.Links.getByName(bookmarkName) 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 getTranslation("convertIndesignFootnotesFinish") 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 Dim i As Integer 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.Title = getTranslation("replaceParaStyleDialogTitle") 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 getTranslation("replaceParaStyleStylesEqualsNotification") Exit sub EndIf If oldStyleName <> "" Then oldStyle = paraStyles.getByName(oldStyleName) If NOT oldStyle.isUserDefined Then MsgBox getTranslation("replaceParaStyleCurrentStyleIsStandard") 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(array As variant, value As variant) As Integer Dim id As Integer Dim nRight As Integer Dim nLen As Integer id = 0 nRight = uBound(array) nLen = len(value) while id <= nRight If array(id) = value Then getIndex = id exit Function Else id = id + 1 end if wend getIndex = -1 End Function Sub subShellSort(mArray) Dim n As Integer Dim h As Integer Dim i As Integer Dim j As Integer Dim t As String Dim Ub As Integer Dim 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 EndIf mArray(j + h) = mArray(j) Next j mArray(j + h) = t Next i h = h \ 3 Loop End Sub