Private sub journalsMark36 End sub Dim templateName As String Dim EIFN As String Dim PHA As String Dim PQ As String Dim imagesRelativePath As String Dim allImagesRelativePath As String Dim path As String Dim sectionName As String Private Sub makeUpIssue turnOffTracking Dim description As String Dim i As Integer Dim statusIndicator as Object Dim oViewCursor As Object Dim oTextCursor As Object Dim articleEndPosition As Object Dim page As String Dim firstPage As String Dim tmp As String Dim nSections As Long description = getTranslation("complileJournalIssueConfirmation") If NOT confirm(description) Then Exit Sub EndIf setZoomToSpeedUpTasks() EIFN = "ЭиФН" PHA = "ФА" PQ = "ВФ" imagesRelativePath = "/Links/Header/" allImagesRelativePath = "/Links/Header-icons/" statusIndicator = ThisComponent.getCurrentController.StatusIndicator oViewCursor = ThisComponent.CurrentController.getViewCursor() sectionName = "" oFilename = ThisComponent.Location 'Exit if no sections in document or document not saved If oFilename = "" Then MsgBox getTranslation("compileJournalIssueNoCurFilename") Exit Sub End If templateName = "" Dim docUserProperties As Object docUserProperties = ThisComponent.DocumentProperties.UserDefinedProperties If docUserProperties.getPropertySetInfo.hasPropertyByName("template") Then templateName = docUserProperties.template EndIf GlobalScope.BasicLibraries.loadLibrary("Tools") path=DirectoryNameoutofPath(ThisComponent.getURL(),"/") ' Add article for each section 'Go to article first page page = findFirstPageNumberWithStyle("Первая страница статьи") firstPage = page oViewCursor.jumpToPage(page) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) statusIndicator.Start(getTranslation("compileJournalIssueStatusInProgerss"),30) For i = 1 To 50 'Find section file FilePath = findArticleFile(path,i) If FilePath="" Then Exit For EndIF 'Add Article If FileExists(FilePath) Then oViewCursor.goToRange(oTextCursor,false) 'Вставить разрыв страницы, если его не было. oTextCursor.BreakType = 4 'Задать стиль первой страницы If NOT IsEmpty(oTextCursor.NumberingRules) Then noNumbering EndIf setArticlePageStyles(i) setAritclePageHeaders(i) page = oViewCursor.getPage() InsertArticle(FilePath) turnOffTracking statusIndicator.setValue(i) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oViewCursor.Text.insertControlCharacter(oTextCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor.collapseToEnd() 'set page to next article page number 'oViewCursor.goToRange(oTextCursor,false) End If fileType = Right(FilePath, 3) 'Go to first page oViewCursor.jumpToPage(page) If fileType = "doc" Then 'Remove blank page at start sendRM() End If sectionName = getSectionX(sectionName) setArticleUniqPageStyles(i) oViewCursor.jumpToPage(page) setAtricleVars(i) oViewCursor.jumpToPage(page) takeWidowLinesIn() oViewCursor.jumpToPage(page) ' takeWidowOrphans() 'Set section name If templateName = "" Then updateUserField("leftHeader" + i , sectionName ) ElseIf templateName = PHA Then updateUserField("leftHeader" + i , sectionName ) ElseIf templateName = EIFN Then updateUserField("rightHeader" + i , getArticleHeader() ) updateUserField("leftHeader" + i , getAuthor ) EndIf Next i statusIndicator.setValue(26) 'remove last empty page oViewCursor.jumpToPage(page) oViewCursor.jumpToPage(lastPageNum(i)) removeEmptyPage() statusIndicator.setValue(28) 'Set pageNums setPageNumbers() statusIndicator.setValue(29) 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) ' Mri oViewCursor 'Задать нумерацию сносок на каждую главу 'ThisComponent.FootnoteSettings.FootnoteCounting=1 'setHeadingsOutlineLevels statusIndicator.end() MsgBox getTranslation("compileJournalIssueFinished") End Sub Private Sub setPageNumbers() updateLastPageFields() End Sub Private Sub setPageNumbersDeprecated() Dim oVeiwCursor As Object Dim pageNum as Integer Dim firstPage as String oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.jumpToFirstPage() firstPage = findFirstPageNumberWithStyle("Статья 1 стр.1") oViewCursor.jumpToPage(firstPage) For i = 1 To 25 pageNum = lastPageNum(i) 'msgBox pageNum If pageNum = -1 Then Exit For End If updateUserField("article" + i + "LastPage", CStr(pageNum) ) Next i End Sub Private Sub setAtricleVars(i As Integer) 'updateUserField("article" + i + "LastPage", CStr(getArticleLastPage()) ) updateUserField("article" + i + "UDK", getUDK()) updateUserField("author" + i + "Copyright", getCopyright() ) 'updateUserField("rightHeader" + i , getTitleHeader() ) End Sub Private Function lastPageNum(i As Integer) Dim docLastPage As Integer Dim curPageNum As Integer Dim oViewCursor As Object curPageNum = -1 oViewCursor = ThisComponent.CurrentController.getViewCursor() Dim oSavePosition As Object oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) oViewCursor.jumpToLastPage() oViewCursor.jumpToEndOfPage() docLastPage = CInt(oViewCursor.getPage()) oViewCursor.goToRange(oSavePosition,false) If CInt(oViewCursor.getPage()) = docLastPage Then lastPageNum = -1 Exit Function End If Dim curPageStyleName As String curPageStyleName = oViewCursor.PageStyleName Do Until InStr(curPageStyleName,"Статья " + CStr(i)) = 0 curPageNum = CInt(oViewCursor.getPage()) If curPageNum = docLastPage Then Exit Do End If If curPageNum = 0 Then MsgBox getTranslation("lastPageNumNotFound") Exit Do End If oViewCursor.jumpToNextPage() curPageStyleName = getNextPageStyleName() If InStr(curPageStyleName,"Статья " + CStr(i+1) + " стр.1") = 1 Then Exit Do End If Loop lastPageNum = curPageNum End Function Private Function getUDK() 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim oViewCursor As Object Dim oSavePosition As Object Dim title As String Dim foundUDK As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) oViewCursor.jumpToStartOfPage() getFirstTextInStyle("УДК") foundUDK = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() If foundUDK = "" Then getUDK = getTranslation("compileJournalIssueSetUDKDummyText") Else getUDK = foundUDK backspace sendRM End If Thiscomponent.CurrentController.select(oSavePosition) End Function Private Function getCopyright() Dim oViewCursor As Object Dim oSavePosition As Object Dim authors As String Dim finalName As String Dim tmpStr As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) getFirstTextInStyle("Автор") authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() If authors <> "" Then finalName = Trim(authors) If Len(finalName) >= 1 Then If Right(finalName, 1) = "." Then getCopyright = "© " + finalName oViewCursor.goToRange(oSavePosition, false) Exit Function EndIf EndIf If Len(authors) >= 4 Then leftSide = Right(authors,Len(authors)-4) rightSide = Left(authors,4) finalName = Trim(leftSide) + " " + rightSide If Right(finalName, 1) <> "." Then getCopyright = "© " + Trim(authors) Else getCopyright = "© " + finalName EndIf oViewCursor.goToRange(oSavePosition, false) Exit Function Else getCopyright = getTranslation("compileJournalIssueCopyrightDummyText") EndIf End If oViewCursor.goToRange(oSavePosition, false) End Function Private Function getAuthor() Dim oViewCursor As Object Dim oSavePosition As Object Dim authors As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) getFirstTextInStyle("Автор") authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() If authors <> "" Then getAuthor = authors Else getAuthor = getTranslation("compileJournalIssueAuthorDummyText") End If oViewCursor.goToRange(oSavePosition, false) End Function Private Function getArticleHeader() Dim oViewCursor As Object Dim oSavePosition As Object Dim authors As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) getFirstTextInStyle("Заголовок 2") articleHeader = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() If articleHeader <> "" Then getArticleHeader = articleHeader Else getArticleHeader = getTranslation("compileJournalIssueArticleTitleDummyText") End If oViewCursor.goToRange(oSavePosition, false) End Function Private Function getSectionX(section As String) Dim oViewCursor As Object Dim oSavePosition As Object Dim startPage As String Dim endPage As String If section = "" Then section = getTranslation("compileJournalIssueSectionDummyText") End If oViewCursor = ThisComponent.CurrentController.getViewCursor() startPage = oViewcursor.getPage() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) getFirstTextInStyle("Заголовок 1") endPage = oViewCursor.getPage() If CInt(startPage) <= CInt(endPage) Then If Len(oViewCursor.Text.createTextCursorByRange(oViewCursor).getString()) > 1 Then section = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() End If section = UCase(Left(section, 1)) + LCase(Right(section,Len(section)-1)) End If getSectionX = section oViewCursor.goToRange(oSavePosition, false) End Function Private Function getTitleHeader() Dim oViewCursor As Object Dim oSavePosition As Object Dim title As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) getFirstTextInStyle("Автор") authors = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() getFirstTextInStyle("Заголовок 2") title = oViewCursor.Text.createTextCursorByRange(oViewCursor).getString() getTitleHeader = authors + " " + title oViewCursor.goToRange(oSavePosition, false) getUDK = title End Function Private Sub setArticlePageStyles(i As Integer) Dim oViewCursor As Object Dim oTextCursor As Object Dim oText As Object Dim page As String Dim pageNum As Long Dim pageStyles As Object Dim articleFirstPageStyle As Object Dim newPageStyleName As String Dim articleFirstPageStyleName As String Dim curStyle As Object Dim tmpStyleName As String Dim firstName As String Dim newName As String Dim newFirstName As String pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") firstName = "Первая страница статьи" newName = "Статья " + CStr(i) newFirstName = newName + " стр.1" oViewCursor = ThisComponent.CurrentController.getViewCursor() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'set starndard first page style name (need for cloning) oTextCursor.PageDescName = firstName 'clone starndard first page style createPageStyleByExample(newFirstName) ' set cloned style to first page oTextCursor.PageDescName = newFirstName 'get current first page style name curStyle = pageStyles.getByName(oViewCursor.pageStyleName) setFirstPageMetadata(curStyle,i) '1 left/right style ' create new para for next page oTextCursor.Text.insertControlCharacter(oTextCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor.BreakType = 4 'clone 1 left/right style createPageStyleByExample(newName) 'set followStyle to previous style curStyle.FollowStyle = newName 'set new curStyle curStyle = pageStyles.getByName(oViewCursor.pageStyleName) oTextCursor.goLeft(1,true) oTextCursor.String = "" End Sub Private Sub setFirstPageMetadata(curStyle As Object,i As Integer) Dim oViewCursor As Object Dim oSavePosition As Object Dim savePageName As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) savePageName = oSavePosition.PageStyleName oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.BreakType = 4 oTextCursor.PageDescName = savePageName If templateName = "" Then setDefaultFirstPageMetadata(curStyle,i) ElseIf templateName = PHA Then setPHAFirstPageMetadata(curStyle,i) ElseIf templateName = EIFN Then setEIFNFirstPageMetadata(curStyle,i) EndIf oViewCursor.goToRange(oSavePosition, false) oViewCursor.jumpToPreviousPage() sendRM() End Sub Private Sub setDefaultFirstPageMetadata(curStyle As Object,i As Integer) Dim oViewCursor As Object Dim oHeaderTable As Object Dim oFooterTable As Object Dim rightHeaderCell As Object Dim leftHeaderCell As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() 'curStyle.HeaderText oHeaderTable = curStyle.HeaderText.CreateEnumeration().nextElement 'leftHeaderCell leftHeaderCell = oHeaderTable.getCellByPosition(0,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) 'go to page number place oViewCursor.gotoEndOfLine(false) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" + i + "LastPage","00" ) oViewCursor.goright(1,false) 'Добавить УДК insertUserField(oViewCursor,"article" + i + "UDK","УДК "+ i + "." + i) 'rightHeaderCell rightHeaderCell = oHeaderTable.getCellByPosition(1,0).getStart() oViewCursor.goToRange(rightHeaderCell, false) 'go to page number 1st place oViewCursor.gotoEndOfLine(false) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" + i + "LastPage","00" ) ' go to page number 2nd place oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" + i + "LastPage","00" ) 'Footer without table oViewCursor.goToRange(curStyle.FooterText.End, false) insertUserField(oViewCursor,"author" + i + "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i ) End Sub Private Sub setPHAFirstPageMetadata(curStyle As Object,i As Integer) Dim oViewCursor As Object Dim oHeader As Object Dim oFooterTable As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oHeader = curStyle.HeaderText.CreateEnumeration().nextElement If oHeader.supportsService("com.sun.star.text.TextTable") Then oAnchor = oHeader.getCellByPosition(0,0).getStart() Else oAnchor = oHeader EndIf oViewCursor.goToRange(oAnchor, false) 'go to page number place oViewCursor.gotoEndOfLine(false) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" + i + "LastPage","00" ) oViewCursor.goright(1,false) 'Добавить УДК insertUserField(oViewCursor,"article" + i + "UDK","УДК "+ i + "." + i) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" + i + "LastPage","00" ) oViewCursor.goToRange(curStyle.FooterText.End, false) insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i ) End Sub Private Sub setEIFNFirstPageMetadata(curStyle,i) Dim oViewCursor As Object Dim oHeaderTable As Object Dim oFooterTable As Object Dim rightHeaderCell As Object Dim leftHeaderCell As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() 'curStyle.HeaderText oHeaderTable = curStyle.HeaderText.CreateEnumeration().nextElement 'leftHeaderCell leftHeaderCell = oHeaderTable.getCellByPosition(0,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) 'go to page number place oViewCursor.gotoEndOfLine(false) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" & i & "LastPage","00" ) oViewCursor.goright(1,false) 'Добавить УДК insertUserField(oViewCursor,"article" & i & "UDK","УДК "+ i + "." + i) 'rightHeaderCell rightHeaderCell = oHeaderTable.getCellByPosition(1,0).getStart() oViewCursor.goToRange(rightHeaderCell, false) 'go to page number 1st place oViewCursor.gotoEndOfLine(false) oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" & i & "LastPage","00" ) ' go to page number 2nd place oViewCursor.goright(1,false) oViewCursor.gotoEndOfLine(false) insertUserField(oViewCursor,"article" & i * "Num","" & i ) oFooterTableLeft = curStyle.FooterTextLeft.CreateEnumeration().nextElement rightHeaderCell = oFooterTableLeft.getCellByPosition(1,0).getStart() oViewCursor.goToRange(rightHeaderCell, false) insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i ) 'TODO!!!!SECOND PAGE oFooterTableRight = curStyle.FooterTextRight.CreateEnumeration().nextElement leftHeaderCell = oFooterTableRight.getCellByPosition(0,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"author" & i & "Copyright",getTranslation("compileJournalIssueCopyrightDummyText") & i ) End Sub Private Sub setAritclePageHeaders(i) Dim oViewCursor As Object Dim oSavePosition As Object Dim rightHeaderTable As Object Dim leftHeaderTable As Object Dim headerCell As Object Dim leftHeaderCell As Object Dim curStyleName As String Dim curStyle As Object Dim page As Integer Dim pageStyles As Object Dim articleStartPosition As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") page = findFirstPageNumberWithStyle("Статья " & i & " стр.1") oViewCursor.jumpToPage(page) articleStartPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'create new para for next page oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'insert page break oTextCursor.BreakType = 4 'create new para for next page oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'insert page break oTextCursor.BreakType = 4 If templateName <> PQ Then If templateName = EIFN Then copySectionIcon(i) EndIf curStyle = pageStyles.getByName(oViewCursor.pageStyleName) rightHeaderTable = curStyle.HeaderTextRight.CreateEnumeration().nextElement leftHeaderTable = curStyle.HeaderTextLeft.CreateEnumeration().nextElement rightHeaderCell = rightHeaderTable.getCellByPosition(0,0).getStart() oViewCursor.goToRange(rightHeaderCell, false) If templateName = "" Then insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueAuthorDummyText") & " " & getTranslation("compileJournalIssueArticleTitleDummyText") & i ) ElseIf templateName = PHA Then insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueAuthorDummyText") & " " & getTranslation("compileJournalIssueArticleTitleDummyText") & i ) ElseIf templateName = EIFN Then insertUserField(oViewCursor,"rightHeader" & i ,getTranslation("compileJournalIssueArticleTitleDummyText") & " " + i ) rightHeaderCell = rightHeaderTable.getCellByPosition(2,0).getStart() oViewCursor.goToRange(rightHeaderCell, false) insertLinkedImage(CStr(i),"headerImageRight") oViewCursor.jumpToStartOfPage() EndIf If templateName = "" Then leftHeaderCell = leftHeaderTable.getCellByPosition(1,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueSectionDummyText") & i ) ElseIf templateName = PHA Then leftHeaderCell = leftHeaderTable.getCellByPosition(1,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueSectionDummyText") & i ) ElseIf templateName = EIFN Then leftHeaderCell = leftHeaderTable.getCellByPosition(2,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"leftHeader" & i ,getTranslation("compileJournalIssueInitialsAuthorDummyText") & i ) leftHeaderCell = leftHeaderTable.getCellByPosition(0,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertLinkedImage(CStr(i),"headerImageLeft") oViewCursor.jumpToStartOfPage() EndIf EndIf oViewCursor.goToRange(articleStartPosition, false) backspace() backspace() backspace() oViewCursor.goToRange(oSavePosition, false) End Sub Private Sub setArticleUniqPageStyles(i) Dim firstPageName As String Dim pageName As String Dim curPageNum As Integer Dim prevPageNum As String Dim leftPageNum As Long Dim docPages As Long Dim articlePages As Long Dim previousPageStyle As Object Dim pageStyles As Object Dim curPageStyle As Object Dim curPageStyleName As String Dim nextStyle As Object Dim clonedStyle As Object Dim clonedStyleName As String Dim oViewCursor As Object Dim newPageName As String oViewCursor = ThisComponent.CurrentController.getViewCursor() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") 'Constants articlePageNum = 1 pageName = "Статья " + CStr(i) firstPageName = pageName + " стр.1" curPageStyleName = oViewCursor.PageStyleName Do Until InStr(curPageStyleName,pageName) = 0 newPageName = pageName + " стр." + articlePageNum curPageNum = CInt(oViewCursor.getPage()) ' Если мы находимся на первой странице статьи If InStr(curPageStyleName, firstPageName) = 1 Then curPageStyle = pageStyles.getByName(curPageStyleName) previousPageStyle = curPageStyle ElseIf InStr(curPageStyleName, pageName) = 1 Then createPageStyleByExample(newPageName) previousPageStyle.FollowStyle = newPageName curPageStyle = pageStyles.getByName(newPageName) curPageStyle.FollowStyle = pageName previousPageStyle = curPageStyle ElseIf oViewCursor.getPage() <> curPageNum Then 'Пришли в конец. 'MsgBox "Статья закончилась!" Exit Sub Else Exit Sub End If 'Iterate article page number articlePageNum = articlePageNum + 1 'GO TO NEXT PAGE If Not oViewCursor.jumpToNextPage() Then MsgBox "setArticleUniqPageStyles failed" End EndIf curPageStyleName = getNextPageStyleName() Loop End Sub Private Sub takeWidowLinesIn Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() curPageStyleName = getNextPageStyleName() Do Until InStr(curPageStyleName,"Статья") = 0 takeLineIn() oViewCursor.jumpToNextPage() curPageStyleName = getNextPageStyleName() Loop End Sub Private Sub takeDownOrpahns Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() curPageStyleName = getNextPageStyleName() Do Until InStr(curPageStyleName,"Статья") = 0 takeLineIn oViewCursor.jumpToNextPage() curPageStyleName = getNextPageStyleName() Loop End Sub Private Sub takeLineIn Dim oViewCursor As Object Dim oTextCursor As Object dim oEndPage As Object Dim lineCounter As Integer lineCounter = 0 oViewCursor = ThisComponent.CurrentController.getViewCursor() 'If page is less than 4 rows then shrink content oViewCursor.jumpToEndOfPage() oEnd = oViewCursor.getPosition() oViewCursor.jumpToStartOfPage() 'Если в таблице - выходим oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If NOT IsEmpty(oTextCursor.TextTable) Then Exit Sub End If oViewCursor.jumpToStartOfPage() ' Идем конец строки, закончился ли параграф lineCounter = lineCounter + 1 Do Until lineCounter = 4 'Test for empty line at 3 row oViewCursor.goToEndOfLine(false) If oEnd.X = oViewCursor.getPosition().X AND oEnd.Y = oViewCursor.getPosition().Y Then shrinkPageContent() Exit Sub End If oViewCursor.goRight(1,false) 'If empty para then remove it and shrink content If oEnd.X = oViewCursor.getPosition().X AND oEnd.Y = oViewCursor.getPosition().Y Then oViewCursor.goLeft(1,false) 'sendRM() shrinkPageContent() Exit Sub End If lineCounter = lineCounter + 1 Loop 'Count page lines oViewCursor.jumpToStartOfPage() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'If It is a start of paragraph then there is no line to take in If oTextCursor.isStartOfParagraph() Then 'Nothing to Do Exit Sub End If oViewCursor.goToEndOfLine(false) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'If it is a last line of paragraph If oTextCursor.isEndOfParagraph() Then shrinkPageContent() Exit Sub End If oViewCursor.goToEndOfLine(false) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'If it is a last line of paragraph If oTextCursor.isEndOfParagraph() Then shrinkPageContent() Exit Sub End If End Sub Private Function getNextPageStyleName() dim curPageStyleName as String dim startPageStyleName as String dim startPageStyle as Object dim pageStyles as Object dim followStyle as String dim oViewCursor as Object dim oTextCursor as Object oViewCursor = ThisComponent.CurrentController.getViewCursor() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") startPageStyleName = oViewCursor.PageStyleName startPageStyle = pageStyles.getByName(startPageStyleName) followStyle = startPageStyle.FollowStyle oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If oTextCursor.isStartOfParagraph() Then getNextPageStyleName = oViewCursor.PageStyleName Exit Function EndIf oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.goRight(1,false) oViewCursor.goToRange(oTextCursor,false) getNextPageStyleName = oViewCursor.pageStyleName oViewCursor.goLeft(1,false) backspace() End Function Private Function findArticleFile(path,i) Dim NextFile As String Dim TestName As String Dim endChars(2) As String endChars(0) = "_" endChars(1) = "." endChars(2) = " " Dim FoundPosition As Long Dim EndChar As String NextFile = Dir(path+"/", 0) While NextFile <> "" For j = LBound(endChars) To UBound(endChars) TestName = CStr(i)+endChars(j) FoundPosition = InStr(NextFile, TestName) If FoundPosition = 1 Then findArticleFile = path+"/"+NextFile Exit Function End If Next NextFile = Dir Wend findArticleFile = "" End Function Private Function InsertArticle(oFileName) Dim document as Object Dim dispatcher as object Dim fileType as String Dim oFilter as String Dim args2(1) as new com.sun.star.beans.PropertyValue document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") fileType = Right(oFileName, 3) If fileType = "odt" Then oFilter = "writer8" ElseIf fileType = "doc" Then oFilter = "MS Word 97" End If args2(0).Name = "Name" args2(0).Value = oFileName args2(1).Name = "Filter" args2(1).Value = oFilter dispatcher.executeDispatch(document, ".uno:InsertDoc", "", 0, args2()) End Function Private Sub getChapter Dim testText As String testText = getFirstTextInStyle("Заголовок 1") End Sub Private Function getFirstTextInStyle(styleName) Dim oViewCursor As Object Dim curPage As Long Dim foundPage As Long oViewCursor = ThisComponent.CurrentController.getViewCursor() curPage = oViewCursor.getPage getFirstTextInStyleDispatch(styleName) foundPage = oViewCursor.getPage If foundPage >= curPage Then getFirstTextInStyle = oViewCursor.String Exit Function End If getFirstTextInStyle = "" End Function Private Sub setHeadingsOutlineLevels setHeadingOutlineLevel(1,"Заголовок 1") setHeadingOutlineLevel(2,"Заголовок 2") End Sub Sub setHeadingOutlineLevel(num,targetStyleName) Dim oViewCursor As Object Dim oText As Object Dim curText As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.jumpToFirstPage getFirstTextInStyleDispatch(targetStyleName) While True curText = oViewCursor.Text.createTextCursorByRange(oViewCursor) If IsNull(oText) Then oText = curText ElseIf oText.Text.compareRegionStarts(oText,curText) = 0 AND oText.Text.compareRegionEnds(oText,curText) = 0 Then Exit Sub End If oViewCursor.OutlineLevel = num getFirstTextInStyleDispatch(targetStyleName) Wend End Sub Private sub getFirstTextInStyleDispatch(styleName) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(21) as new com.sun.star.beans.PropertyValue args1(0).Name = "SearchItem.StyleFamily" args1(0).Value = 2 args1(1).Name = "SearchItem.CellType" args1(1).Value = 0 args1(2).Name = "SearchItem.RowDirection" args1(2).Value = true args1(3).Name = "SearchItem.AllTables" args1(3).Value = false args1(4).Name = "SearchItem.SearchFiltered" args1(4).Value = false args1(5).Name = "SearchItem.Backward" args1(5).Value = false args1(6).Name = "SearchItem.Pattern" args1(6).Value = true args1(7).Name = "SearchItem.Content" args1(7).Value = false args1(8).Name = "SearchItem.AsianOptions" args1(8).Value = false args1(9).Name = "SearchItem.AlgorithmType" args1(9).Value = 0 args1(10).Name = "SearchItem.SearchFlags" args1(10).Value = 65536 args1(11).Name = "SearchItem.SearchString" args1(11).Value = styleName args1(12).Name = "SearchItem.ReplaceString" args1(12).Value = styleName args1(13).Name = "SearchItem.Locale" args1(13).Value = 255 args1(14).Name = "SearchItem.ChangedChars" args1(14).Value = 2 args1(15).Name = "SearchItem.DeletedChars" args1(15).Value = 2 args1(16).Name = "SearchItem.InsertedChars" args1(16).Value = 2 args1(17).Name = "SearchItem.TransliterateFlags" args1(17).Value = 1280 args1(18).Name = "SearchItem.Command" args1(18).Value = 0 args1(19).Name = "SearchItem.SearchFormatted" args1(19).Value = false args1(20).Name = "SearchItem.AlgorithmType2" args1(20).Value = 1 args1(21).Name = "Quiet" args1(21).Value = true dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1()) end Sub Private sub insertLinkedImage(articleNum,styleName) rem ---------------------------------------------------------------------- rem define variables dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args2(3) as new com.sun.star.beans.PropertyValue args2(0).Name = "FileName" args2(0).Value = path + imagesRelativePath + articleNum + ".jpg" args2(1).Name = "FilterName" args2(1).Value = "<Все форматы>" args2(2).Name = "AsLink" args2(2).Value = true args2(3).Name = "Style" args2(3).Value = styleName dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, args2()) end sub Private Sub copySectionIcon(articleNum) FileCopy( path + allImagesRelativePath + getImageFileName(), path + imagesRelativePath + articleNum + ".jpg") End Sub Private Function getImageFileName() Select Case UCase(sectionName) Case "АРХИВ" getImageFileName = "ARCHIVE.jpg" Case "СИТУАЦИОННЫЕ ИССЛЕДОВАНИЯ" getImageFileName = "CASE_STUDIES.jpg" Case "МЕЖДИСЦИПЛИНАРНЫЕ ИССЛЕДОВАНИЯ" getImageFileName = "INTERDISCIPLINARY.jpg" Case "ПАНЕЛЬНАЯ ДИСКУССИЯ" getImageFileName = "PANEL_DISCUSSION.jpg" Case "ОБЗОРЫ КНИГ" getImageFileName = "BOOK_REVIEWS.jpg" Case "РЕДАКЦИОННАЯ СТАТЬЯ" getImageFileName = "EDITORIAL.jpg" Case "ЯЗЫК И СОЗНАНИЕ" getImageFileName = "LANGUAGE.jpg" Case "ПЕРСПЕКТИВА" getImageFileName = "VISTA.jpg" Case "ЭПИСТЕМОЛОГИЯ И ПОЗНАНИЕ" getImageFileName = "EPISTEMOLOGY.jpg" Case Else getImageFileName = "EDITORIAL.jpg" End Select End Function Private sub noNumbering rem ---------------------------------------------------------------------- rem define variables 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") rem ---------------------------------------------------------------------- dim args1(0) as new com.sun.star.beans.PropertyValue Wait 500 dispatcher.executeDispatch(document, ".uno:RemoveBullets", "", 0, args1()) Wait 500 end sub Private Sub updateLastPageFields 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 cell As Object Dim cellEnum As Object Dim cellEnum2 As Object Dim pageStyleName As String Dim articleName As String Dim articleNamePrefix As String Dim articleNamePostfix As String Dim strPos As Integer Dim articleNum As Integer Dim curNum As Integer Dim pageNum As String Dim textCursor As Object Dim lastPages%( 100 ) For i = 0 to 100 lastPages%(i) = 0 next i articleNum = 0 articleName = "0" articleNamePrefix = "Статья " articleNamePostfix = " " Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.statusIndicator statusIndicator.Start(getTranslation("compileJournalIssueStatusUpdateLastPageNumbers"),30) enum1 = ThisComponent.Text.createEnumeration While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") Then pageStyleName = getPageStyleNameFromEnum(enum1Element) If Len(pageStyleName) > 0 Then strPos = InStr(pageStyleName, articleNamePrefix) If strPos <> 0 Then articleName = Right(pageStyleName, Len(pageStyleName)-Len(articleNamePrefix)) strPos = InStr(articleName, articleNamePostfix) If strPos > 0 Then articleName = Left(articleName,strPos) EndIf 'If first article reached If articleNum = 0 Then articleNum = CInt(Trim(articleName)) EndIf Else articleName = "0" EndIf If articleNum > 0 Then curNum = CInt(Trim(articleName)) If articleNum <> curNum Then pageNum = getPageNumber(enum1Element.Start) lastPages(articleNum) = CInt(pageNum) - 1 articleNum = curNum EndIf EndIf EndIf EndIf 'TODO: 'OR enum1Element.supportsService("com.sun.star.text.TextTable") Wend For i = LBound(lastPages) to UBound(lastPages) If lastPages%(i) <> 0 Then updateUserField("article" + i + "LastPage",lastPages%(i)) EndIf next i statusIndicator.end() End Sub Function insertUserField(cursor,fieldName,fieldValue) Dim oField As Object 'Field to insert Dim oFieldMaster As Object Dim oMasters As Object oTextCursor = cursor.Text.createTextCursorByRange(cursor.Start) oField = ThisComponent.createInstance("com.sun.star.text.textfield.User") oMasters = ThisComponent.getTextFieldMasters() If oMasters.hasByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) Then oFieldMaster = oMasters.getByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) oFieldMaster.Name = fieldName oFieldMaster.Content = fieldValue Else oFieldMaster = ThisComponent.createInstance("com.sun.star.text.FieldMaster.User") oFieldMaster.Name = fieldName oFieldMaster.Content = fieldValue EndIf oField.attachTextFieldMaster(oFieldMaster) oTextCursor.Text.insertTextContent(oTextCursor, oField, False) End Function Function updateUserField(fieldName,fieldValue) Dim oFieldMaster As Object Dim oMasters As Object oMasters = ThisComponent.getTextFieldMasters() If oMasters.hasByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) Then oFieldMaster = oMasters.getByName("com.sun.star.text.FieldMaster.User" & "." & fieldName) oFieldMaster.Content = fieldValue EndIf End Function Sub createPageStyleByExample(newName) dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(1) as new com.sun.star.beans.PropertyValue args1(0).Name = "Param" args1(0).Value = newName args1(1).Name = "Family" args1(1).Value = 8 dispatcher.executeDispatch(document, ".uno:StyleNewByExample", "", 0, args1()) end Sub sub sendRM dim document as Object dim dispatcher as Object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Delete", "", 0, Array()) end Sub sub backspace dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:SwBackspace", "", 0, Array()) end Sub Sub configureCursorPositionForContentShrink() ' Globalscope.BasicLibraries.LoadLibrary("MRILib") Dim oViewCursor As Object Dim oTextCursor As Object Dim curSelection As Object Dim selectionTextRange As Object Dim nextChar As String Dim prefChar As String oViewCursor = ThisComponent.CurrentController.getViewCursor() fixViewCursor() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'At start of Para oTextCursor.collapseToEnd() If oTextCursor.isStartOfParagraph() AND NOT oTextCursor.isEndOfParagraph() Then oTextCursor.goLeft(1,false) EndIf oViewCursor.goToRange(oTextCursor,false) End Sub Sub fixViewCursor() Dim oViewCursor As Object Dim curSelection As Object Dim selectionTextRange As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() curSelection = ThisComponent.getCurrentSelection() If Not curSelection.supportsService("com.sun.star.text.TextRanges") Then selectionTextRange = curSelection.Anchor oViewCursor.JumpToFirstPage(false) oViewCursor.goToRange(selectionTextRange,false) EndIf End Sub Function isContentPageChanged(initPosition As Object,initPageNum As String) As Boolean Dim oViewCursor As Object Dim oTextCursor As Object isShrinkPageSucceded = false oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToRange(initPosition,false) If (oViewCursor.getPage <> initPageNum) Then isContentPageChanged = true EndIf End Function Function breakParaAtCursor() As Object Dim oViewCursor As Object Dim oTextCursor As Object Dim leftMargin As Long oViewCursor = ThisComponent.CurrentController.getViewCursor() oTextCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor) If NOT oTextCursor.isEndOfParagraph() Then oTextCursor.goLeft(1,false) oTextCursor.goRight(2,true) insertHyphen(oTextCursor) oTextCursor.goLeft(1,false) oViewCursor.goToRange(oTextCursor,false) leftMargin = oViewCursor.ParaLeftMargin insertPara oViewCursor.ParaFirstLineIndent = leftMargin oTextCursor.goLeft(1,false) oViewCursor.goToRange(oTextCursor,false) breakParaAtCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor) Else 'oTextCursor.goRight(1,false) 'oViewCursor.goToRange(oTextCursor,false) 'oViewCursor.BreakType = com.sun.star.style.BreakType.PAGE_BEFORE 'oTextCursor.goLeft(1,false) 'oViewCursor.goToRange(oTextCursor,false) breakParaAtCursor = oViewcursor.Text.createTextCursorByRange(oViewCursor) EndIf End Function sub insertPara dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:InsertPara", "", 0, Array()) end sub Function canShrinkContent() As Boolean Dim oViewCursor As Object Dim oTextCursor As Object Dim oSavePosition As Object Dim oStartPosition As Object Dim initPageNum As Long Dim startPageNum As Long oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) canShrinkContent = true 'In endntote footnote or table shrink is not possible If oViewCursor.Text.supportsService("com.sun.star.text.Endnote") OR _ oViewCursor.Text.supportsService("com.sun.star.text.Footnote") OR _ oViewCursor.Text.supportsService("com.sun.star.text.CellProperties") Then canShrinkContent = false oViewCursor.goToRange(oSavePosition,false) Exit Function EndIf initPageNum = oViewcursor.getPage() oViewCursor.JumpToPreviousPage(false) oViewCursor.jumpToStartOfPage() startPageNum = oViewcursor.getPage() 'No previous page exists If startPageNum = initPageNum Then oViewCursor.goToRange(oSavePosition,false) canShrinkContent = false Exit Function EndIf 'If current paragraph has page break before If oSavePosition.BreakType <> 0 Then oTextCursor = oSavePosition.Text.createTextCursorByRange(oSavePosition) oTextCursor.gotoStartOfParagraph(false) oViewCursor.goToRange(oTextCursor,false) If oViewCursor.getPage() = initPageNum Then canShrinkContent = false oViewCursor.goToRange(oSavePosition,false) Exit Function EndIf EndIf oViewCursor.goToRange(oSavePosition,false) oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) Do While oViewcursor.getPage() = initPageNum oTextCursor.gotoPreviousParagraph(false) oViewCursor.goToRange(oTextCursor,false) If oTextCursor.BreakType <> 0 AND oViewcursor.getPage() = initPageNum Then canShrinkContent = false oViewCursor.goToRange(oSavePosition,false) Exit Function EndIf Loop oViewCursor.goToRange(oSavePosition,false) End Function Function shrinkPageContent() As Boolean Dim oViewCursor As Object Dim oTextCursor As Object Dim initPosition As Object Dim initPageNum As String Dim oSaveEndSelection As Object Dim oEnum As Variant Dim oPar As Object Dim startOfPara As Boolean Dim targetContent() As Object Dim delta As Double Dim rounds As Integer delta = 0.1 rounds = 3 Dim roundsLineHeight As Integer roundsLineHeight = 3 Dim i As Integer Dim j As Integer shrinkPageContent = false oViewCursor = ThisComponent.CurrentController.getViewCursor() configureCursorPositionForContentShrink() If Not canShrinkContent() Then Exit Function EndIf initPageNum = oViewcursor.getPage() initPosition = breakParaAtCursor() oViewcursor.goToRange(initPosition,false) oViewCursor.JumpToPreviousPage(false) oViewCursor.jumpToStartOfPage() startPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) targetContent = selectContentToShrink(initPosition,startPosition) For i = LBound(targetContent) To Ubound(targetContent) shrinkContentSpacing(targetContent(i)) If isContentPageChanged(initPosition, initPageNum) Then Exit Function EndIf Next i 'TODO: Уменьшая отступы каждого параграфа от и до следующего ' а также уменьшая кернинг, межстрочное расстояние и кегль For j = 0 To rounds For i = LBound(targetContent) To Ubound(targetContent) If (j > 0) Then decreaseContentCharHeight(targetContent(i), delta) EndIf If shrinkContentWithKerning(targetContent(i)) Then balanceContentTail(targetContent(i),false) EndIf If isContentPageChanged(initPosition, initPageNum) Then Exit Function EndIf Next i Next j For j = 1 To roundsLineHeight For i = LBound(targetContent) To Ubound(targetContent) decreaseIntervalHeight(targetContent(i)) If isContentPageChanged(initPosition, initPageNum) Then Exit Function EndIf Next i Next j For j = 1 To roundsLineHeight For i = LBound(targetContent) To Ubound(targetContent) increaseIntervalHeight(targetContent(i)) Next i Next j For i = LBound(targetContent) To Ubound(targetContent) increaseContentCharHeight(targetContent(i), delta * rounds ) Next i End Function Function increaseIntervalHeight(oContent As Object) As Boolean increaseIntervalHeight = false Dim oParEnum As Object Dim oPar As Object Dim oSecEnum As Object Dim oParSection As Object Dim pageNum As Integer Dim lineSpacing As Object If Not IsMissing(oContent.ParaLineSpacing) Then lineSpacing = oContent.ParaLineSpacing If lineSpacing.Mode = 3 Then lineSpacing.Height = lineSpacing.Height / 0.98 oContent.ParaLineSpacing = lineSpacing increaseIntervalHeight = true End If End If End Function Function decreaseIntervalHeight(oContent As Object) As Boolean decreaseIntervalHeight = false Dim oParEnum As Object Dim oPar As Object Dim oSecEnum As Object Dim oParSection As Object Dim pageNum As Integer Dim lineSpacing As Object If Not IsMissing(oContent.ParaLineSpacing) Then lineSpacing = oContent.ParaLineSpacing If lineSpacing.Mode = 3 Then lineSpacing.Height = lineSpacing.Height * 0.98 oContent.ParaLineSpacing = lineSpacing decreaseIntervalHeight = true End If EndIf End Function Sub decreaseContentCharHeight(oContent As Object, delta As double) Dim contentEnum As Object'paragraph enumeration Dim textContentElement As Object'current paragraph Dim curHeight As Double Dim oTextCursor As Object contentEnum = oContent.createEnumeration() Do While contentEnum.hasMoreElements() textContentElement = contentEnum.nextElement() oTextCursor = textContentElement.Text.createTextCursorByRange(textContentElement) curHeight = oTextCursor.charHeight oTextCursor.charHeight = roundHeight(curHeight) - delta Loop End Sub Sub increaseContentCharHeight(oContent As Object, delta As double) Dim contentEnum As Object'paragraph enumeration Dim textContentElement As Object'current paragraph Dim curHeight As Double Dim oTextCursor As Object contentEnum = oContent.createEnumeration() Do While contentEnum.hasMoreElements() textContentElement = contentEnum.nextElement() oTextCursor = textContentElement.Text.createTextCursorByRange(textContentElement) curHeight = oTextCursor.charHeight oTextCursor.charHeight = roundHeight(curHeight) + delta Loop End Sub Function roundHeight(nHeight) As Double Dim lHeight As Double Dim hHeight As Double lHeight = Int(nHeight) hHeight = Int(nHeight) Dim i% i=1 Do While lHeight < nHeight And hHeight < nHeight lHeight = + i/10 + 0.001 hHeight = + (i+0.5)/10 i=i+1 Loop roundHeight=lHeight End Function Function shrinkContentSpacing(oContent As Object) As Boolean ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) shrinkContentSpacing = false If oContent.ParaTopMargin > MIN_SPACING_TO_SHRINK Then oContent.ParaTopMargin = 0 EndIf If oContent.ParaBottomMargin > MIN_SPACING_TO_SHRINK Then oContent.ParaTopMargin = 0 EndIf End Function Function selectContentToShrink(initPosition As Object, startPosition As Object) Dim oViewCursor As Object Dim oTextCursor As Object Dim startPageNum As Long Dim prevPageNum As Long Dim savePosition As Object Dim foundPrevPara As Boolean Dim targetContent() As Variant oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewcursor.goToRange(startPosition,false) prevPageNum = oViewcursor.getPage() oViewcursor.goToRange(initPosition,false) startPageNum = oViewcursor.getPage() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) Do While startPageNum = oViewcursor.getPage() OR prevPageNum = oViewcursor.getPage() savePosition = oTextCursor.getStart() oTextCursor.gotoStartOfParagraph(true) oViewCursor.goToRange(oTextCursor,false) oViewCursor.collapseToStart() If Len(oTextCursor.String) > 0 Then If (startPageNum = oViewcursor.getPage() OR prevPageNum = oViewcursor.getPage()) Then AddToArray(targetContent,oTextCursor.Text.createTextCursorByRange(oTextCursor)) Else oTextCursor.goToRange(savePosition,false) oViewCursor.goToRange(oTextCursor,false) oViewCursor.JumpToStartOfPage(false) oTextCursor.goToRange(oViewCursor,true) AddToArray(targetContent,oTextCursor.Text.createTextCursorByRange(oTextCursor)) EndIf EndIf foundPrevPara = oTextCursor.gotoPreviousParagraph(false) If (foundPrevPara = false) Then Exit Do EndIf oTextCursor.gotoEndOfParagraph(false) oViewCursor.goToRange(oTextCursor,false) Loop selectContentToShrink = targetContent End Function Sub insertPageBreak dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:InsertPagebreak", "", 0, Array()) End Sub Sub insertHyphen(twoCharactersToHyphen As Object) Dim oViewCursor As Object Dim document as Object Dim dispatcher as Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToRange(twoCharactersToHyphen,false) document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dim args1(21) as new com.sun.star.beans.PropertyValue args1(0).Name = "SearchItem.StyleFamily" args1(0).Value = 2 args1(1).Name = "SearchItem.CellType" args1(1).Value = 0 args1(2).Name = "SearchItem.RowDirection" args1(2).Value = true args1(3).Name = "SearchItem.AllTables" args1(3).Value = false args1(4).Name = "SearchItem.SearchFiltered" args1(4).Value = false args1(5).Name = "SearchItem.Backward" args1(5).Value = false args1(6).Name = "SearchItem.Pattern" args1(6).Value = false args1(7).Name = "SearchItem.Content" args1(7).Value = false args1(8).Name = "SearchItem.AsianOptions" args1(8).Value = false args1(9).Name = "SearchItem.AlgorithmType" args1(9).Value = 1 args1(10).Name = "SearchItem.SearchFlags" args1(10).Value = 71680 args1(11).Name = "SearchItem.SearchString" args1(11).Value = "([a-zA-Zа-яА-Я])([a-zA-Zа-яА-Я])" args1(12).Name = "SearchItem.ReplaceString" ' "$1 U+00AD $2" args1(12).Value = "$1­$2" args1(13).Name = "SearchItem.Locale" args1(13).Value = 255 args1(14).Name = "SearchItem.ChangedChars" args1(14).Value = 2 args1(15).Name = "SearchItem.DeletedChars" args1(15).Value = 2 args1(16).Name = "SearchItem.InsertedChars" args1(16).Value = 2 args1(17).Name = "SearchItem.TransliterateFlags" args1(17).Value = 1024 args1(18).Name = "SearchItem.Command" args1(18).Value = 3 args1(19).Name = "SearchItem.SearchFormatted" args1(19).Value = false args1(20).Name = "SearchItem.AlgorithmType2" args1(20).Value = 2 args1(21).Name = "Quiet" args1(21).Value = true dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1()) end sub sub saveCurrentVersion rem ---------------------------------------------------------------------- rem define variables 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") rem ---------------------------------------------------------------------- dim args1(0) as new com.sun.star.beans.PropertyValue args1(0).Name = "VersionComment" args1(0).Value = getTranslation("saveVersionCommentInsertPageBreak") dispatcher.executeDispatch(document, ".uno:Save", "", 0, args1()) end sub Sub removeEmptyPage Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.jumpToStartOfPage() Dim oTextCursor As Object oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oViewCursor.jumpToEndOfPage() oViewCursor.goToRange(oTextCursor,true) If oViewCursor.isCollapsed Then oViewCursor.goLeft(1,false) SendRM() Else oViewCursor.jumpToEndOfPage() End If oViewCursor.collapseToEnd() End Sub Function getPageStyleNameFromEnum(enumElement) If enumElement.pageDescName = "" AND Not IsEmpty(enumElement.getPropertyValue("PageStyleName")) Then getPageStyleNameFromEnum = enumElement.pageStyleName Else getPageStyleNameFromEnum = enumElement.pageDescName EndIf End Function Function getPageNumber(cursor As Object) As String Dim oField As Object Dim oTextCursor As Object oTextCursor = cursor.Text.createTextCursorByRange(cursor.Start) oField = ThisComponent.createInstance("com.sun.star.text.textfield.PageNumber") oField.NumberingType = 4 oField.SubType = com.sun.star.text.PageNumberType.CURRENT oTextCursor.Text.insertTextContent(oTextCursor, oField, False) oField.Anchor.CharHidden = False oField.Anchor.CharHidden = True getPageNumber = oField.getPresentation(false) oTextCursor.Text.removeTextContent(oField) End Function