Private sub journalsMark1 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 description = "Вы уверены, что хотите запустить сборку выпуска ?" If NOT confirm(description) Then Exit Sub EndIf EIFN = "ЭиФН" PHA = "ФА" PQ = "ВФ" imagesRelativePath = "/Links/Header/" allImagesRelativePath = "/Links/Header-icons/" Dim statusIndicator as Object statusIndicator = ThisComponent.getCurrentController.StatusIndicator Dim oViewCursor As Object Dim oTextCursor As Object Dim articleEndPosition As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() Dim page As String Dim firstPage As String Dim tmp As String sectionName = "" Dim nSections As Long oFilename = ThisComponent.Location 'Exit if no sections in document or document not saved If oFilename = "" Then MsgBox "Сначала сохраните выпуск в папке с файлами статьей" 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("Сборка выпуска начата, подождите",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() 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) '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) 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 "Произошла ошибка при нахождении последней страницы статьи" 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 = "Задать УДК" 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 = "© " + "Фамилия И.О." 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 = "Фамилия И.О." 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 = "Название статьи" End If oViewCursor.goToRange(oSavePosition, false) End Function Private Function getSectionX(section) Dim oViewCursor As Object Dim oSavePosition As Object Dim startPage As String Dim endPage As String If section = "" Then section = "Задайте название радела!" 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) 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,i) 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,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 + "LastPage","00" ) 'Footer without table oViewCursor.goToRange(curStyle.FooterText.End, false) insertUserField(oViewCursor,"author" + i + "Copyright","© Фамилия И.О. " + i ) End Sub Private Sub setPHAFirstPageMetadata(curStyle,i) 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","© Фамилия И.О. " + 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","© Фамилия И.О. " + i ) 'TODO!!!!SECOND PAGE oFooterTableRight = curStyle.FooterTextRight.CreateEnumeration().nextElement leftHeaderCell = oFooterTableRight.getCellByPosition(0,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"author" + i + "Copyright","© Фамилия И.О. " + 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 ,"Фамилия И.О. Название статьи" + i ) ElseIf templateName = PHA Then insertUserField(oViewCursor,"rightHeader" + i ,"Фамилия И.О. Название статьи" + i ) ElseIf templateName = EIFN Then insertUserField(oViewCursor,"rightHeader" + i ,"Название статьи " + 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 ,"Название раздела" + i ) ElseIf templateName = PHA Then leftHeaderCell = leftHeaderTable.getCellByPosition(1,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"leftHeader" + i ,"Название раздела" + i ) ElseIf templateName = EIFN Then leftHeaderCell = leftHeaderTable.getCellByPosition(2,0).getStart() oViewCursor.goToRange(leftHeaderCell, false) insertUserField(oViewCursor,"leftHeader" + i ,"И.О. Фамилия" + 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 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 Globalscope.BasicLibraries.LoadLibrary( "Publishing" ) 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 Integer 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("Производится обновление полей последних номеров страниц, подождите",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