1Attribute VB_Name = "Preparation" 2'/************************************************************************* 3' * 4' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 5' 6' Copyright 2000, 2010 Oracle and/or its affiliates. 7' 8' OpenOffice.org - a multi-platform office productivity suite 9' 10' This file is part of OpenOffice.org. 11' 12' OpenOffice.org is free software: you can redistribute it and/or modify 13' it under the terms of the GNU Lesser General Public License version 3 14' only, as published by the Free Software Foundation. 15' 16' OpenOffice.org is distributed in the hope that it will be useful, 17' but WITHOUT ANY WARRANTY; without even the implied warranty of 18' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19' GNU Lesser General Public License version 3 for more details 20' (a copy is included in the LICENSE file that accompanied this code). 21' 22' You should have received a copy of the GNU Lesser General Public License 23' version 3 along with OpenOffice.org. If not, see 24' <http://www.openoffice.org/license.html> 25' for a copy of the LGPLv3 License. 26' 27' ************************************************************************/ 28Option Explicit 29 30Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, _ 31 var As Variant, currDoc As Document) As Boolean 32 On Error GoTo HandleErrors 33 Dim currentFunctionName As String 34 currentFunctionName = "Prepare_HeaderFooter_GraphicFrames" 35 36 Dim myPrepInfo As PrepareInfo 37 Set myPrepInfo = var 38 39 Dim smove As Long 40 Dim temp As Single 41 Dim ELength As Single 42 Dim PageHeight As Single 43 Dim Snum As Integer 44 Dim Fnum As Integer 45 Dim I As Integer 46 Dim myshape As Shape 47 Dim shapetop() As Single 48 Dim temptop As Single 49 50 With currDoc.ActiveWindow 'change to printview 51 If .View.SplitSpecial = wdPaneNone Then 52 .ActivePane.View.Type = wdPrintView 53 Else 54 .Panes(2).Close 55 .ActivePane.View.Type = wdPrintView 56 .View.Type = wdPrintView 57 End If 58 End With 59 60 PageHeight = currDoc.PageSetup.PageHeight 61 PageHeight = PageHeight / 2 62 63 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 64 count:=myPrepInfo.HF_OnPage 65 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 66 67 Snum = myPrepInfo.HF_Shapes.count 68 If Snum <> 0 Then 69 ReDim shapetop(Snum) 70 ReDim top(Snum) 71 I = 0 72 For Each myshape In myPrepInfo.HF_Shapes 73 If myshape.Type = msoPicture Then 74 If myshape.RelativeVerticalPosition <> wdRelativeVerticalPositionPage Then 75 shapetop(I) = myshape.top + myshape.Anchor.Information(wdVerticalPositionRelativeToPage) 76 Else 77 shapetop(I) = myshape.top 78 End If 79 ElseIf myshape.Type = msoTextBox Then 80 myshape.TextFrame.TextRange.Select 81 82 shapetop(I) = Selection.Information(wdVerticalPositionRelativeToPage) 83 End If 84 I = I + 1 85 Next myshape 86 End If 87 88 currDoc.Content.Select 89 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 90 count:=myPrepInfo.HF_OnPage 'set frametop might change the selection position 91 92 If myPrepInfo.HF_inheader Then 93 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 94 Selection.MoveStart 95 ELength = 0 96 While ELength < myPrepInfo.HF_extendLength 97 Selection.TypeParagraph 98 ELength = ELength + Selection.Characters.First.Font.Size 99 Wend 100 Else 101 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 102 Selection.MoveStart 103 ELength = 0 104 While ELength < myPrepInfo.HF_extendLength 105 Selection.TypeParagraph 106 ELength = ELength + Selection.Characters.First.Font.Size 107 Wend 108 End If 109 110 If Snum <> 0 Then 111 I = 0 112 For Each myshape In myPrepInfo.HF_Shapes 113 If myshape.Type = msoPicture Then 114 If myshape.RelativeVerticalPosition <> wdRelativeVerticalPositionPage Then 115 temptop = myshape.top + myshape.Anchor.Information(wdVerticalPositionRelativeToPage) 116 Else 117 temptop = myshape.top 118 End If 119 ElseIf myshape.Type = msoTextBox Then 120 myshape.TextFrame.TextRange.Select 121 122 temptop = Selection.Information(wdVerticalPositionRelativeToPage) 123 End If 124 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 125 count:=myPrepInfo.HF_OnPage 126 If myPrepInfo.HF_inheader Then 127 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 128 Else 129 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 130 End If 131 Selection.HeaderFooter.Shapes(myshape.name).Select 132 Selection.ShapeRange.IncrementTop shapetop(I) - temptop 133 I = I + 1 134 Next myshape 135 End If 136 ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 137 Prepare_HeaderFooter_GraphicFrames = True 138FinalExit: 139 Exit Function 140 141HandleErrors: 142 WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 143 Resume FinalExit 144End Function 145 146'Stub for Excel Prepare SheetName 147Function Prepare_WorkbookVersion() As Boolean 148 Prepare_WorkbookVersion = False 149End Function 150 151 152