Private sub journalsMark28 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 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 25 '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 oViewCursor.goToRange(oSavePosition, false) 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 oViewCursor.jumpToNextPage() 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 shrinkPageContent Dim oViewCursor As Object 'View cursor Dim oTextCursor As Object 'Text cursor Dim oViewCurInitPosition As Object Dim oSaveEndSelection 'Text cursor Dim oEnum 'Cursor enumeration Dim oPar 'Current paragraph Dim sTextContent$ 'Service name for text content. Dim scaleWidthShrinkValue As Integer Dim scaleCharHeight As Integer Dim scaleIntervalHeight As Integer Dim kernShrinkValue As Integer Dim startOfPara As Boolean 'saveCurrentVersion kernShrinkValue = 8 scaleWidthShrinkValue = 7 scaleCharHeight = 2 scaleIntervalHeight = 3 sTextContent = "com.sun.star.text.TextContent" oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCurInitPosition = oViewcursor.Text.createTextCursorByRange(oViewCursor) 'Check if we are at start of paragraph go to the end of previous paragraph If oViewCursor.Text.createTextCursorByRange(oViewCursor).isStartOfParagraph() Then oViewCursor.goLeft(1,false) If Len(oViewCursor.String) <> 1 Then oViewCursor.goRight(1,false) End If End If 'Move right to select left and right characters and save position to the right oViewCursor.goRight(1,false) oSaveEndSelection = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'Select last 2 characters oViewCursor.goLeft(2,true) If Len(oViewCursor.String) = 2 Then oLastChars = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'Insert hyphen if needed insertHyphen(oLastChars,oViewCursor) End If 'Return to initial position oViewCursor.gotoRange(oSaveEndSelection,false) 'Go to end of text to check page changes oViewCursor.goLeft(1,false) 'Set saved position to initial state oSaveEndSelection = oViewCursor.Text.createTextCursorByRange(oViewCursor) oViewCursor.jumpToPreviousPage() oViewCursor.jumpToStartOfPage() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'If one of textRanges is Footnote or Endnote we can't select them so it is better to exit now If oTextCursor.Text.supportsService("com.sun.star.text.Endnote") OR oTextCursor.Text.supportsService("com.sun.star.text.Footnote") Or oTextCursor.Text.supportsService("com.sun.star.text.CellProperties") Then shrinkPageContent = false oViewCursor.gotoRange(oViewCurInitPosition,false) Exit Sub EndIf If oSaveEndSelection.Text.supportsService("com.sun.star.text.Endnote") OR oSaveEndSelection.Text.supportsService("com.sun.star.text.Footnote") Or oTextCursor.Text.supportsService("com.sun.star.text.CellProperties") Then shrinkPageContent = false oViewCursor.gotoRange(oViewCurInitPosition,false) Exit Sub EndIf oTextCursor.gotoRange(oSaveEndSelection,true) oViewCursor.gotoRange(oSaveEndSelection,false) 'Go to end of text to check page changes If shrinkIntervalHeight(oTextCursor,oViewCursor,scaleIntervalHeight) Then oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If oTextCursor.isEndOfParagraph() Then pos1 = oViewCursor.getPage() oViewCursor.goRight(1,false) pos2 = oViewCursor.getPage() 'If we moved right to the next para and page haven't changed insert pageBreak If pos1 = pos2 Then insertPageBreak End If Else insertPageBreak If Not IsNull(oTextCursor.ParaFirstLineIndent) Then oTextCursor.ParaFirstLineIndent = 0 End If End If Exit Sub End If If shrinkCharHeight(oTextCursor,oViewCursor,scaleCharHeight) Then oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If oTextCursor.isEndOfParagraph() Then pos1 = oViewCursor.getPage() oViewCursor.goRight(1,false) pos2 = oViewCursor.getPage() 'If we moved right to the next para and page haven't changed insert pageBreak If pos1 = pos2 Then insertPageBreak End If Else insertPageBreak If Not IsNull(oTextCursor.ParaFirstLineIndent) Then oTextCursor.ParaFirstLineIndent = 0 End If End If Exit Sub End If If shrinkKern(oTextCursor,oViewCursor,kernShrinkValue) Then oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If oTextCursor.isEndOfParagraph() Then pos1 = oViewCursor.getPage() oViewCursor.goRight(1,false) pos2 = oViewCursor.getPage() 'If we moved right to the next para and page haven't changed insert pageBreak If pos1 = pos2 Then insertPageBreak End If Else insertPageBreak If Not IsNull(oTextCursor.ParaFirstLineIndent) Then oTextCursor.ParaFirstLineIndent = 0 End If End If Exit Sub End If End Sub Sub splitPages Dim oViewCursor As Object 'View cursor Dim oText 'Text object in current document Dim oSaveEndSelection 'Text cursor 'saveCurrentVersion oViewCursor = ThisComponent.CurrentController.getViewCursor() Dim saveFirstLineIndent As Boolean 'Check if we are at start of paragraph go to the end of previous paragraph If oViewCursor.Text.createTextCursorByRange(oViewCursor).isEndOfParagraph() Then oViewCursor.goRight(1,false) End If If oViewCursor.Text.createTextCursorByRange(oViewCursor).isStartOfParagraph() Then saveFirstLineIndent = true Else saveFirstLineIndent = false End If oViewCursor.goRight(1,false) oSaveEndSelection = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'Select last 2 characters oViewCursor.goLeft(2,true) If Len(oViewCursor.String) = 2 Then 'Insert hyphen if needed oLastChars = oViewCursor.Text.createTextCursorByRange(oViewCursor) insertHyphen(oLastChars,oViewCursor) End If 'Return to initial position oViewCursor.gotoRange(oSaveEndSelection,false) 'Go to end of text to check page changes oViewCursor.goLeft(1,false) insertPageBreak If Not saveFirstLineIndent Then oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If Not IsNull(oTextCursor.ParaFirstLineIndent) Then oTextCursor.ParaFirstLineIndent = 0 End If End If End Sub Function shrinkScaleWidth(oTextCursor,oViewCursor,iterations) As Boolean Dim oParEnum 'paragraph enumeration Dim oPar 'current paragraph Dim oSecEnum 'sections enumeration Dim oParSection 'paragraph text section Dim pageNum As Integer pageNum = oViewCursor.getPage() For i = 1 To iterations Step 1 oParEnum = oTextCursor.createEnumeration() Do While oParEnum.hasMoreElements() oPar = oParEnum.nextElement() If oPar.supportsService("com.sun.star.text.Paragraph") Then oPar.charScaleWidth = 100 - i If pageNum <> oViewCursor.getPage() Then shrinkScaleWidth = true Exit Function End If End If Loop Next i shrinkScaleWidth = false End Function Function shrinkKern(oTextCursor,oViewCursor,iterations) As Boolean Dim oParEnum 'paragraph enumeration Dim oPar 'current paragraph Dim oSecEnum 'sections enumeration Dim oParSection 'paragraph text section Dim pageNum As Integer pageNum = oViewCursor.getPage() For i = 2 To iterations Step 2 oParEnum = oTextCursor.createEnumeration() Do While oParEnum.hasMoreElements() oPar = oParEnum.nextElement() If oPar.supportsService("com.sun.star.text.Paragraph") Then oPar.CharKerning = 0 - i If pageNum <> oViewCursor.getPage() Then shrinkKern = true Exit Function End If End If Loop Next i shrinkKern = false End Function Function shrinkCharHeight(oTextCursor,oViewCursor,iterations) As Boolean Dim oParEnum 'paragraph enumeration Dim oPar 'current paragraph Dim oSecEnum 'sections enumeration Dim oParSection 'paragraph text section Dim pageNum As Integer pageNum = oViewCursor.getPage() For i = 1 To iterations Step 1 oParEnum = oTextCursor.createEnumeration() Do While oParEnum.hasMoreElements() oPar = oParEnum.nextElement() If oPar.supportsService("com.sun.star.text.Paragraph") Then oPar.charHeight = roundHeight(oPar.charHeight) - 0.1 If pageNum <> oViewCursor.getPage() Then shrinkCharHeight = true Exit Function End If End If Loop Next i shrinkCharHeight = false End Function Function roundHeight(nHeight) 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 shrinkIntervalHeight(oTextCursor,oViewCursor,iterations) As Boolean Dim oParEnum 'paragraph enumeration Dim oPar 'current paragraph Dim oSecEnum 'sections enumeration Dim oParSection 'paragraph text section Dim pageNum As Integer Dim lineSpacing pageNum = oViewCursor.getPage() For i = 1 To iterations Step 1 oParEnum = oTextCursor.createEnumeration() Do While oParEnum.hasMoreElements() oPar = oParEnum.nextElement() If oPar.supportsService("com.sun.star.text.Paragraph") Then lineSpacing = oPar.ParaLineSpacing If lineSpacing.Mode = 3 Then lineSpacing.Height = lineSpacing.Height * 0.98 oPar.ParaLineSpacing = lineSpacing End If If pageNum <> oViewCursor.getPage() Then shrinkIntervalHeight = true Exit Function End If End If Loop Next i shrinkIntervalHeight = false End Function Sub savecursor Dim oViewCursor As Object 'View cursor Dim oTextCursor 'Text cursor Dim oSaveEndSelection 'Text cursor Dim oEnum 'Cursor enumeration Dim oText 'Text object in current document Dim oPar 'Current paragraph Dim sTextContent$ 'Service name for text content. sTextContent = "com.sun.star.text.TextContent" oViewCursor = ThisComponent.CurrentController.getViewCursor() oSaveEndSelection = oViewCursor.Text.createTextCursorByRange(oViewCursor) REM oViewCursor.getText.insertString(oViewCursor.getStart(), CHR$(257), False) 'If Not oViewCursor.jumpToPreviousPage() Then Exit Sub oViewCursor.jumpToPreviousPage() oViewCursor.jumpToStartOfPage() 'oViewCursor.goUp(10,true) 'oViewCursor.getPage() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) 'oTextCursor.gotoStart(false) oTextCursor.gotoRange(oSaveEndSelection,true) oParEnum = oTextCursor.createEnumeration() Do While oParEnum.hasMoreElements() Dim oSubSection Dim oSecEnum Do While oParEnum.hasMoreElements() oPar = oParEnum.nextElement() oPar.charScaleWidth = oPar.charScaleWidth - 1 Dim charHeight charHeight= oPar.charHeight Dim lineSpacing lineSpacing = oPar.ParaLineSpacing MsgBox lineSpacing.Mode & lineSpacing.Height If oPar.supportsService("com.sun.star.text.Paragraph") Then nPars = nPars + 1 oSecEnum = oPar.createEnumeration() s = s & nPars & ":" Do While oSecEnum.hasMoreElements() oParSection = oSecEnum.nextElement() oParSection.charScaleWidth = oParSection.charScaleWidth - 1 oParSection.CharHeight = oParSection.CharHeight * 0.99 s = s & oParSection.TextPortionType & " Scale " & oParSection.CharScaleWidth & " Scale " & oParSection.CharHeight & ":" Loop s = s & CHR$(10) If nPars MOD 10 = 0 Then MsgBox s, 0, "Paragraph Text Sections" s = "" End If End If Loop Loop End Sub sub insertPageBreak 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 ---------------------------------------------------------------------- dispatcher.executeDispatch(document, ".uno:InsertPagebreak", "", 0, Array()) end sub Sub insertHyphen(oTextCursor,oViewCursor) Dim lastChars 'lastChars = oTextCursor.getString() replacementhyp 'MsgBox lastChars End Sub sub replacementhyp 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(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" 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