Sub albumMark6 End Sub Sub rotatePageButton Dim curPageStyleName As String Dim pageStyles As Object Dim pageStyle As Object curPageStyleName = getCurPageStyleName() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageStyle = pageStyles.getByName(curPageStyleName) If pageStyle.IsLandScape Then undoPageAlbum Else makePageAlbum EndIf End Sub Sub makePageAlbum Dim curPageStyleName As String 'saveVersion("Перед выполнением макроса повоорта страницы в альбомную ориентацию") curPageStyleName = getCurPageStyleName() findBestAnchor() If checkPageSettings(curPageStyleName) Then MsgBox getTranslation("albumRotationCheckPageSettings") Exit Sub EndIf rotatePageClockwise(curPageStyleName) End Sub Sub findBestAnchor() Dim curPageStyleName As String Dim oViewCursor As Object Dim oTextCursor As Object curPageStyleName = getCurPageStyleName() oViewCursor = ThisComponent.CurrentController.getViewCursor() oViewCursor.jumpToStartOfPage() oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor.End) If NOT oTextCursor.isStartOfParagraph Then oTextCursor.goToNextParagraph(false) oViewCursor.goToRange(oTextCursor,false) EndIf If curPageStyleName = getCurPageStyleName() Then Exit Sub EndIf MsgBox getTranslation("unrecoverableError") End Sub Sub undoPageAlbum Dim curPageStyleName As String curPageStyleName = getCurPageStyleName() applyPortraitPageStyle(curPageStyleName) End Sub sub applyPortraitPageStyle(pageStyleName As String) Dim pageStyles As Object Dim pageStyle As Object Dim oViewCursor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageStyle = pageStyles.getByName(pageStyleName) If NOT pageStyle.IsLandScape Then MsgBox getTranslation("albumRotationPageIsAlreadyAlbum") Exit sub EndIf If pageStyles.hasByName("portrait_" & pageStyleName) Then replacePageStyleByPortrait(pageStyleName) removeAlbumFrames(pageStyleName) Else MsgBox getTranslation("albumRotationBackupStyleNotFound1") & " portrait_" & pageStyleName & " " & getTranslation("albumRotationBackupStyleNotFound2") EndIf End Sub Sub replacePageStyleByPortrait(pageStyleName As String) Dim pageStyles As Object Dim pageStyle As Object Dim oldPageStyle As Object Dim textEnumeration As Object Dim enumerationElement As Object Dim i As Integer pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") oldPageStyle = pageStyles.getByName(pageStyleName) For i = 0 To pageStyles.getCount() - 1 pageStyle = pageStyles.getByIndex(i) If pageStyle.FollowStyle = pageStyleName Then pageStyle.FollowStyle = "portrait_" & pageStyleName EndIf If pageStyle.getName() = "portrait_" & pageStyleName Then pageStyle.FollowStyle = oldPageStyle.FollowStyle EndIf Next i pageStyle = pageStyles.getByName("portrait_" & pageStyleName) pageStyle.Hidden = false pageStyle.FollowStyle = oldPageStyle.FollowStyle 'Replace in direct formatting textEnumeration = ThisComponent.Text.createEnumeration While textEnumeration.hasMoreElements enumerationElement = textEnumeration.nextElement If enumerationElement.pageDescName = pageStyleName Then enumerationElement.pageDescName = "portrait_" & pageStyleName EndIf Wend 'Replace album style by portrait If oldPageStyle.IsUserDefined() Then pageStyles.removeByName(pageStyleName) pageStyles.getByName("portrait_" & pageStyleName).setName(pageStyleName) EndIf End Sub Sub removeAlbumFrames(pageStyleName As String) Dim drawPagesEnum As Object Dim drawPage As Object drawPagesEnum = ThisComponent.DrawPage.CreateEnumeration() While drawPagesEnum.hasMoreElements() drawPage = drawPagesEnum.nextElement() If drawPage.getName() = "header_" & pageStyleName Or drawPage.getName() = "footer_" & pageStyleName Then drawPage.dispose() EndIf Wend End Sub sub savePortraitPageStyle(pageStyleName As String) createPageStyleByExample("portrait_" & pageStyleName) hidePageStyle("portrait_" & pageStyleName) End Sub Sub hidePageStyle(pageStyleName As String) 'Globalscope.BasicLibraries.LoadLibrary("MRILib") Dim pageStyles As Object Dim pageStyle As Object pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageStyle = pageStyles.getByName(pageStyleName) pageStyle.Hidden = true End Sub Sub rotatePageClockwise(pageStyleName As String) Dim pageStyles As Object Dim pageStyle As Object Dim tmpDimension As Long Dim frame As Object Dim frameName As String Dim oViewCursor As Object Dim pageNumber As Long Dim headerFrameW As Long Dim headerFrameH As Long Dim headerFrameYOffset As Long Dim headerFrameXOffset As Long Dim footerFrameW As Long Dim footerFrameH As Long Dim footerFrameYOffset As Long Dim footerFrameXOffset As Long Dim textElement As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() pageNumber = oViewCursor.getPage() pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageStyle = pageStyles.getByName(pageStyleName) If pageStyle.IsLandScape Then MsgBox getTranslation("albumRotationPageIsAlreadyAlbum") Exit sub EndIf If NOT pageStyle.IsUserDefined() Then pageStyleName = "new" & pageStyleName createPageStyleByExample(pageStyleName) oViewCursor.pageDescName = pageStyleName pageStyle = pageStyles.getByName(pageStyleName) EndIf savePortraitPageStyle(pageStyleName) If pageStyle.HeaderIsOn Then headerFrameW = pageStyle.HeaderHeight - pageStyle.HeaderBodyDistance headerFrameH = pageStyle.Width - pageStyle.HeaderLeftMargin - pageStyle.HeaderRightMargin - pageStyle.LeftMargin - pageStyle.RightMargin headerFrameYOffset = pageStyle.HeaderLeftMargin + pageStyle.LeftMargin headerFrameXOffset = pageStyle.Height - pageStyle.TopMargin - (pageStyle.HeaderHeight - pageStyle.HeaderBodyDistance) EndIf If pageStyle.FooterIsOn Then footerFrameW = pageStyle.FooterHeight - pageStyle.FooterBodyDistance footerFrameH = pageStyle.Width - pageStyle.FooterLeftMargin - pageStyle.FooterRightMargin - pageStyle.LeftMargin - pageStyle.RightMargin footerFrameYOffset = pageStyle.FooterLeftMargin + pageStyle.LeftMargin footerFrameXOffset = pageStyle.BottomMargin EndIf rotatePageClockwiseMargins(pageStyle) rotatePageOrientation(pageStyle) If pageStyle.HeaderIsOn Then If NOT pageStyle.FirstIsShared Then textElement = pageStyle.HeaderTextFirst ElseIf NOT pageStyle.HeaderIsShared Then If pageNumber Mod 2 = 1 Then textElement = pageStyle.HeaderTextRight Else textElement = pageStyle.HeaderTextLeft EndIf Else textElement = pageStyle.HeaderText EndIf frameName = "header_" & pageStyleName copyTextToFrame(textElement,headerFrameXOffset,headerFrameYOffset,headerFrameW,headerFrameH,frameName) EndIf If pageStyle.FooterIsOn Then If NOT pageStyle.FirstIsShared Then textElement = pageStyle.FooterTextFirst ElseIf NOT pageStyle.FooterIsShared Then If pageNumber Mod 2 = 1 Then textElement = pageStyle.FooterTextRight Else textElement = pageStyle.FooterTextLeft EndIf Else textElement = pageStyle.FooterText EndIf frameName = "footer_" & pageStyleName copyTextToFrame(textElement,footerFrameXOffset,footerFrameYOffset,footerFrameW,footerFrameH,frameName) EndIf removePageHeader(pageStyle) removePageFooter(pageStyle) End Sub Sub rotatePageClockwiseMargins(pageStyle) Dim tmpDimension As Long tmpDimension = pageStyle.LeftMargin If pageStyle.FooterIsOn Then pageStyle.LeftMargin = pageStyle.BottomMargin + pageStyle.FooterHeight Else pageStyle.LeftMargin = pageStyle.BottomMargin EndIf pageStyle.BottomMargin = pageStyle.RightMargin If pageStyle.HeaderIsOn Then pageStyle.RightMargin = pageStyle.TopMargin + pageStyle.HeaderHeight Else pageStyle.RightMargin = pageStyle.TopMargin EndIf pageStyle.TopMargin = tmpDimension End Sub Sub rotatePageOrientation(pageStyle) Dim tmpDimension As Long tmpDimension = pageStyle.Height pageStyle.Height = pageStyle.Width pageStyle.Width = tmpDimension pageStyle.IsLandscape = Not pageStyle.IsLandscape End Sub Function checkPageSettings(pageStyleName As String) As Boolean Dim pageStyles As Object Dim pageStyle As Object checkPageSettings = false pageStyles = ThisComponent.StyleFamilies.getByName("PageStyles") pageStyle = pageStyles.getByName(pageStyleName) If pageStyle.HeaderIsOn Then If pageStyle.HeaderIsDynamicHeight Then checkPageSettings = true pageStyle.HeaderIsDynamicHeight = false MsgBox getTranslation("albumRotationDynamicHeaderHeight") EndIf If pageStyle.HeaderDynamicSpacing Then checkPageSettings = true pageStyle.HeaderDynamicSpacing = false MsgBox getTranslation("albumRotationDynamicHeaderOffset") EndIf EndIf If pageStyle.FooterIsOn Then If pageStyle.FooterIsDynamicHeight Then checkPageSettings = true pageStyle.FooterIsDynamicHeight = false MsgBox getTranslation("albumRotationDynamicFooterHeight") EndIf If pageStyle.FooterDynamicSpacing Then checkPageSettings = true pageStyle.FooterDynamicSpacing = false MsgBox getTranslation("albumRotationDynamicFooterOffset") EndIf EndIf 'Workaround to force Writer reread new page settings If checkPageSettings Then pageStyle.FirstIsShared = true pageStyle.FirstIsShared = false pageStyle.FirstIsShared = true EndIf End Function Sub copyTextToFrame(textElement As Object,frameXOffset As Long,frameYOffset As Long,frameW As Long,frameH As Long,frameName As String) Dim oViewCursor As Object Dim initialCursorPosition As Object Dim frame As Object Dim enumeration As Object Dim firstElement As Boolean Dim element As Object Dim cellNames() As String Dim firstCellAnchor As Object Dim lastCellAnchor As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() initialCursorPosition = oViewCursor.Text.createTextCursorByRange(oViewCursor.End) frame = createFrame(frameXOffset,frameYOffset,frameW,frameH,frameName) enumeration = textElement.CreateEnumeration() firstElement = true While enumeration.hasMoreElements element = enumeration.nextElement() If element.supportsService("com.sun.star.text.TextTable") Then cellNames = element.getCellNames() element.IsWidthRelative = false firstCellAnchor = element.getCellByName(cellNames(LBound(cellNames))).getStart() lastCellAnchor = element.getCellByName(cellNames(UBound(cellNames))).getEnd() oViewCursor.goToRange(firstCellAnchor,false) oViewCursor.goToRange(lastCellAnchor,true) unoCopy() oViewCursor.goToRange(frame.Text.End,false) unoPaste() If firstElement Then frame.Text.CreateEnumeration().nextElement.dispose() EndIf ElseIf element.supportsService("com.sun.star.text.Paragraph") Then oViewCursor.goToRange(element,false) unoCopy() oViewCursor.goToRange(frame.Text.End,false) unoPaste() EndIf firstElement = false Wend oViewCursor.goToRange(initialCursorPosition,false) End Sub Sub removePageHeader(pageStyle As Object) pageStyle.headerIsOn = false End Sub Sub removePageFooter(pageStyle As Object) pageStyle.FooterIsOn = false End Sub Function getCurPageStyleName() As String dim curPageStyleName as String dim oViewCursor as Object dim oTextCursor as Object oViewCursor = ThisComponent.CurrentController.getViewCursor() If Not oViewCursor.isAtEndOfLine() And Not oViewCursor.isAtStartOfLine() Then oViewCursor.goToStartOfLine(false) EndIf oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) If oTextCursor.isStartOfParagraph() Then getCurPageStyleName = oViewCursor.PageStyleName Exit Function EndIf If oTextCursor.isEndOfParagraph() Then getCurPageStyleName = oViewCursor.PageStyleName Exit Function EndIf oViewCursor.Text.insertControlCharacter(oViewCursor.End,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False) oViewCursor.paraOrphans = 0 oViewCursor.paraWidows = 0 oTextCursor = oViewCursor.Text.createTextCursorByRange(oViewCursor) oTextCursor.goRight(1,false) oViewCursor.goToRange(oTextCursor,false) getCurPageStyleName = oViewCursor.pageStyleName oViewCursor.goLeft(1,false) backspace() End Function Sub unoCopy dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array()) End Sub sub unoPaste dim document as object dim dispatcher as object document = ThisComponent.CurrentController.Frame dispatcher = createUnoService("com.sun.star.frame.DispatchHelper") dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array()) end sub Function createFrame(posX As Long,posY As Long,width As Long,height As Long,frameName As String) As Object Dim oViewCursor as Object Dim oTextCursor as Object Dim oText As Object Dim frame As Object Dim border As Object oViewCursor = ThisComponent.CurrentController.getViewCursor() oText = oViewCursor.Text oTextCursor = oText.createTextCursorByRange(oViewCursor.End) frame = ThisComponent.createInstance("com.sun.star.text.TextFrame") frame.AnchorType = 2 frame.Height = height frame.Width = width frame.PageToggle = false frame.BorderDistance = 0 frame.HoriOrient = 0 frame.HoriOrientRelation = 7 frame.HoriOrientPosition= posX frame.VertOrient = 0 frame.VertOrientRelation = 7 frame.VertOrientPosition = posY oText.insertTextContent(oTextCursor.Start, frame, false) frame.FrameIsAutomaticHeight = false border = frame.bottomBorder border.OuterLineWidth = 0 border.LineWidth = 0 frame.bottomBorder = border frame.topBorder = border frame.leftBorder = border frame.rightBorder = border frame.WritingMode = 2 frame.PositionProtected = true frame.Name = frameName createFrame = frame End Function