Sub markBooks7 End Sub Sub setUniqPageStyles Dim pageStyleBreaks As Variant Dim filteredDupStyles As Variant pageStyleBreaks = getPageStyleBreaks() Dim pageCount As Integer Dim pageStyleNames() As String Dim pageNumbers() As Integer Dim pageStarts() As Object Dim pageCounter As Integer pageStyleNames = pageStyleBreaks(0) pageNumbers = pageStyleBreaks(1) pageStarts = pageStyleBreaks(2) 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) pageCount = thiscomponent.currentController.pageCount Dim fullChain(pageCount - 1) As String Dim dupNames() As String Dim dupCounters() As Integer Dim chainNum As Integer Dim pageStyleFamily As Object Dim pageStyle As Object pageStyleFamily = ThisComponent.StyleFamilies.getByName("PageStyles") chainNum = 0 For pageCounter = 1 To pageCount If pageNumbers(chainNum) = pageCounter Then fullChain(pageCounter - 1) = pageStyleNames(chainNum) If Ubound(pageNumbers) > chainNum Then chainNum = chainNum + 1 EndIf Else pageStyle = pageStyleFamily.getByName(fullChain(pageCounter - 1 - 1)) fullChain(pageCounter - 1) = pageStyle.FollowStyle EndIf Dim dupPosition As Integer dupPosition = getIndex(dupNames, fullChain(pageCounter - 1) ) If dupPosition = -1 Then addToArray(dupNames, fullChain(pageCounter - 1)) addToArray(dupCounters, 1) Else dupCounters(dupPosition) = dupCounters(dupPosition) + 1 EndIf Next pageCounter filteredDupStyles = filterPageStyleNames(dupNames,dupCounters) filteredDupStyles = createDupNames(filteredDupStyles) Dim duplicateNames() As String Dim initNames() As String Dim dupName As String duplicateNames = filteredDupStyles(2) initNames = filteredDupStyles(0) createPageStyleClones(filteredDupStyles) chainNum = 0 Dim curName As String Dim pageStart As Object Dim prevPageStyle As Object Dim index As Integer For pageCounter = 1 To pageCount If pageNumbers(chainNum) = pageCounter Then index = getIndex(initNames, pageStyleNames(chainNum)) If index > -1 Then pageStart = pageStarts(chainNum) dupName = getDuplicate(duplicateNames(index)) pageStart.pageDescName = dupName fullChain(pageCounter - 1) = dupName EndIf If Ubound(pageNumbers) > chainNum Then chainNum = chainNum + 1 EndIf Else curName = fullChain(pageCounter - 1) index = getIndex(initNames, curName) If index > -1 Then dupName = getDuplicate(duplicateNames(index)) prevPageStyle = pageStyleFamily.getByName(fullChain(pageCounter - 1 - 1)) prevPageStyle.FollowStyle = dupName fullChain(pageCounter - 1) = dupName EndIf EndIf Next pageCounter MsgBox getTranslation("allPagesHaveUniqPageStyle") End Sub Function getDuplicate(duplicateNames() As String) As String Dim index As Integer Dim dupName As String For index = LBound(duplicateNames) To Ubound(duplicateNames) dupName = duplicateNames(index) If dupName <> "" Then getDuplicate = dupName duplicateNames(index) = "" Exit Function EndIf Next index End Function Sub createPageStyleClones(filteredDupStyles As Variant) 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim oViewCursor As Object Dim initialNames() As String Dim dupNames() As Variant Dim initialName As String Dim style As Object initialNames = filteredDupStyles(0) dupNames = filteredDupStyles(2) Dim pageStyleFamily As Object pageStyleFamily = ThisComponent.StyleFamilies.getByName("PageStyles") oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.goToEnd(False) Dim index As Integer Dim dupInedx As Integer insertPageBreak() Dim duplicates() As String Dim duplicate As String Dim pageStyleOriginals As Integer Dim newStyle As Object For index = LBound(initialNames) To Ubound(initialNames) initialName = initialNames(index) style = pageStyleFamily.getByName(initialName) oViewCursor.PageDescName = style.Name duplicates = dupNames(index) For dupIndex = LBound(duplicates) To Ubound(duplicates) duplicate = duplicates(dupIndex) createPageStyleByExample(duplicate) newStyle = pageStyleFamily.getByName(duplicate) newStyle.FollowStyle = style.Name Next Next backspace End Sub Function createDupNames(dupStyles As Variant) As Variant Dim newDupStyles(2) As Variant Dim counters() As Integer Dim initNames() As String Dim initName As String initNames = dupStyles(0) counters = dupStyles(1) Dim newDupNames() As Variant Dim i As Integer Dim nameIt As Integer For i = LBound(counters) To UBound(counters) ReDim newNames(counters(i) - 1) As String addToArray(newDupNames, newNames) initName = initNames(i) For nameIt = LBound(newNames) To UBound(newNames) newNames(nameIt) = createDupName(initName, newDupNames) newDupNames(UBound(newDupNames)) = newNames Next nameIt Next i newDupStyles(0) = initNames newDupStyles(1) = counters newDupStyles(2) = newDupNames createDupNames = newDupStyles End Function Function createDupName(initName As String, newDupNames As Variant ) Dim pageStyleFamily As Object pageStyleFamily = ThisComponent.StyleFamilies.getByName("PageStyles") Dim proposeName As String Dim i As Integer Dim postfix As String Dim prefixName As String prefixName = getPrefixName(initName) For i = 1 To 10000 proposeName = prefixName & i If NOT pageStyleFamily.hasByName(proposeName) And Not IsInArrays(newDupNames, proposeName) Then createDupName = proposeName Exit Function EndIf Next i End Function Function getPrefixName(initName As String) As String Dim num As Long Dim tmpName As String tmpName = Trim(initName) If tmpName = "" Then getPrefixName = "" Exit Function EndIf num = Asc(Right(tmpName, 1)) Do while num >= 48 AND num <= 57 tmpName = Trim(Left(tmpName, Len(tmpName) - 1)) If tmpName = "" Then getPrefixName = "" Exit Function EndIf num = Asc(Right(tmpName, 1)) Loop If tmpName = "Статья" Then Dim result As String result = Trim(initName) & " стр." getPrefixName = result Exit Function EndIf If Len(tmpName) > 4 AND Right(tmpName,4) = "стр." Then getPrefixName = tmpName Exit Function EndIf getPrefixName = tmpName & " " End Function Function IsInArrays(newDupNames As Variant, proposeName As String) As Boolean 'Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim i As Integer Dim names() As String For i = LBound(newDupNames) To Ubound(newDupNames) names = newDupNames(i) If getIndex(names, proposeName) > -1 Then IsInArrays = True Exit Function EndIf Next i IsInArrays = False End Function Function filterPageStyleNames(names() As String, counters() As Integer) As Variant Dim i As Integer Dim filteredNames() As String Dim filteredCounters() As Integer For i=Lbound(counters) To Ubound(counters) If counters(i) > 1 Then addToArray(filteredNames, names(i)) addToArray(filteredCounters, counters(i)) EndIf Next i Dim filteredDups(1) As Variant filteredDups(0) = filteredNames filteredDups(1) = filteredCounters filterPageStyleNames = filteredDups End Function Function getPageStyleBreaks() Dim enum1 As Object Dim enum1Element As Object Dim pageStyleName As String Dim pageNumber As Integer Dim pageName As String Dim oViewCursor As Object Dim anchor As Object Dim oSavePosition As Object Dim pageStyleBreaks(2) As Variant Dim pageStyleNames() As String Dim pageNumbers() As Integer Dim pageStarts() As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() enum1 = ThisComponent.Text.createEnumeration() ' Globalscope.BasicLibraries.LoadLibrary( "MRILib" ) Dim i As Integer i = 0 Dim first As Boolean first = true While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") OR enum1Element.supportsService("com.sun.star.text.TextTable") Then ' MRi enum1Element If NOT isEmpty(enum1Element.PageDescName) And enum1Element.PageDescName <> "" Then pageStyleName = enum1Element.PageStyleName addToArray(pageStyleNames(),pageStyleName) If enum1Element.supportsService("com.sun.star.text.Paragraph") Then oViewCursor.goToRange(enum1Element.Anchor,false) ElseIf enum1Element.supportsService("com.sun.star.text.TextTable") Then oViewCursor.goToRange(enum1Element.getCellByPosition(0,0).getStart(),false) EndIf addToArray(pageNumbers(),CInt(oViewCursor.Page)) addToArray(pageStarts(),enum1Element) first = false ElseIf first Then addToArray(pageStyleNames(), enum1Element.PageStyleName) addToArray(pageNumbers(),1) addToArray(pageStarts(),enum1Element) first = false EndIf EndIf i = i + 1 Wend pageStyleBreaks(0) = pageStyleNames pageStyleBreaks(1) = pageNumbers pageStyleBreaks(2) = pageStarts getPageStyleBreaks = pageStyleBreaks End Function Sub setUniqPageStylesDEPRECATED Dim prevPageName As String 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 pageNum As Integer Dim page As Integer oViewCursor = ThisComponent.CurrentController.getViewCursor() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageNum = 1 pageName = "Страница издания" If NOT hasPageStyleWith(pageName) Then MsgBox "Ошибка. Стиль страниц <" & pageName & "> не найден." Exit Sub EndIf page = findFirstPageNumberWithStyle(pageName) firstPage = page oViewCursor.jumpToPage(page) curPageStyleName = oViewCursor.PageStyleName Do While StrComp(curPageStyleName,pageName,1) = 0 If pageNum = 1 Then oViewCursor.jumpToPreviousPage() prevPageName = oViewCursor.PageStyleName previousPageStyle = pageStyles.getByName(prevPageName) tmpName = pageName + " " If InStr(prevPageName, tmpName) = 1 Then startNum = Right(prevPageName,Len(prevPageName) - Len(tmpName)) pageNum = CInt(startNum) + 1 EndIf oViewCursor.jumpToNextPage() EndIf newPageName = pageName + " " + pageNum createPageStyleByExample(newPageName) If pageNum = 1 Then oTextCursor = oViewCursor.Text.CreateTextCursorByRange(oViewCursor) oViewCursor.PageDescName = newPageName Else previousPageStyle.FollowStyle = newPageName EndIf curPageStyle = pageStyles.getByName(newPageName) 'Установим стиль следующей страницы в стандартное значение curPageStyle.FollowStyle = pageName previousPageStyle = curPageStyle oViewCursor.jumpToNextPage() curPageStyleName = getNextPageStyleName() pageNum = pageNum + 1 Loop End Sub Function hasPageStyleWith(pageStyleName As String) As Boolean Dim enum1 As Object Dim enum1Element As Object Dim curPage As String Dim curStyleName As String Dim pageName As String Dim oViewCursor As Object Dim anchor As Object enum1 = ThisComponent.Text.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") OR enum1Element.supportsService("com.sun.star.text.TextTable") Then If NOT IsMissing(enum1Element.PageDescName) AND NOT IsNull(enum1Element.PageDescName) Then pageName = CStr(enum1Element.PageDescName) If pageStyleName = pageName Then hasPageStyleWith = true Exit Function EndIf EndIf EndIf Wend hasPageStyleWith = false End Function Function findFirstPageNumberWithStyle(pageStyleName As String) As Integer Dim enum1 As Object Dim enum1Element As Object Dim curPage As String Dim curStyleName As String Dim pageName As String Dim oViewCursor As Object Dim anchor As Object Dim oSavePosition As Object Dim curPageStyleName As String oViewCursor = ThisComponent.CurrentController.getViewCursor() oSavePosition = oViewCursor.Text.createTextCursorByRange(oViewCursor) enum1 = ThisComponent.Text.createEnumeration() While enum1.hasMoreElements enum1Element = enum1.nextElement If enum1Element.supportsService("com.sun.star.text.Paragraph") OR enum1Element.supportsService("com.sun.star.text.TextTable") Then If NOT IsMissing(enum1Element.PageDescName) AND NOT IsNull(enum1Element.PageDescName) Then pageName = CStr(enum1Element.PageDescName) If pageStyleName = pageName Then anchor = enum1Element.getAnchor() oViewCursor.gotoRange(anchor,false) findFirstPageNumberWithStyle = oViewCursor.getPage() oViewCursor.goToRange(oSavePosition, false) Exit Function EndIf EndIf EndIf Wend findFirstPageNumberWithStyle = -1 End Function sub testStyleCopy 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(1) as new com.sun.star.beans.PropertyValue args1(0).Name = "Param" args1(0).Value = "alb2" args1(1).Name = "Family" args1(1).Value = 8 dispatcher.executeDispatch(document, ".uno:StyleNewByExample", "", 0, args1()) end sub