1Attribute VB_Name = "Preparation" 2'************************************************************************* 3' 4' Licensed to the Apache Software Foundation (ASF) under one 5' or more contributor license agreements. See the NOTICE file 6' distributed with this work for additional information 7' regarding copyright ownership. The ASF licenses this file 8' to you under the Apache License, Version 2.0 (the 9' "License"); you may not use this file except in compliance 10' with the License. You may obtain a copy of the License at 11' 12' http://www.apache.org/licenses/LICENSE-2.0 13' 14' Unless required by applicable law or agreed to in writing, 15' software distributed under the License is distributed on an 16' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 17' KIND, either express or implied. See the License for the 18' specific language governing permissions and limitations 19' under the License. 20' 21'************************************************************************* 22Option Explicit 23 24Function Prepare_HeaderFooter_GraphicFrames(docAnalysis As DocumentAnalysis, myIssue As IssueInfo, _ 25 var As Variant, currDoc As Document) As Boolean 26 On Error GoTo HandleErrors 27 Dim currentFunctionName As String 28 currentFunctionName = "Prepare_HeaderFooter_GraphicFrames" 29 30 Dim myPrepInfo As PrepareInfo 31 Set myPrepInfo = var 32 33 Dim smove As Long 34 Dim temp As Single 35 Dim ELength As Single 36 Dim PageHeight As Single 37 Dim Snum As Integer 38 Dim Fnum As Integer 39 Dim I As Integer 40 Dim myshape As Shape 41 Dim shapetop() As Single 42 Dim temptop As Single 43 44 With currDoc.ActiveWindow 'change to printview 45 If .View.SplitSpecial = wdPaneNone Then 46 .ActivePane.View.Type = wdPrintView 47 Else 48 .Panes(2).Close 49 .ActivePane.View.Type = wdPrintView 50 .View.Type = wdPrintView 51 End If 52 End With 53 54 PageHeight = currDoc.PageSetup.PageHeight 55 PageHeight = PageHeight / 2 56 57 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 58 count:=myPrepInfo.HF_OnPage 59 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 60 61 Snum = myPrepInfo.HF_Shapes.count 62 If Snum <> 0 Then 63 ReDim shapetop(Snum) 64 ReDim top(Snum) 65 I = 0 66 For Each myshape In myPrepInfo.HF_Shapes 67 If myshape.Type = msoPicture Then 68 If myshape.RelativeVerticalPosition <> wdRelativeVerticalPositionPage Then 69 shapetop(I) = myshape.top + myshape.Anchor.Information(wdVerticalPositionRelativeToPage) 70 Else 71 shapetop(I) = myshape.top 72 End If 73 ElseIf myshape.Type = msoTextBox Then 74 myshape.TextFrame.TextRange.Select 75 76 shapetop(I) = Selection.Information(wdVerticalPositionRelativeToPage) 77 End If 78 I = I + 1 79 Next myshape 80 End If 81 82 currDoc.Content.Select 83 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 84 count:=myPrepInfo.HF_OnPage 'set frametop might change the selection position 85 86 If myPrepInfo.HF_inheader Then 87 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 88 Selection.MoveStart 89 ELength = 0 90 While ELength < myPrepInfo.HF_extendLength 91 Selection.TypeParagraph 92 ELength = ELength + Selection.Characters.First.Font.Size 93 Wend 94 Else 95 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 96 Selection.MoveStart 97 ELength = 0 98 While ELength < myPrepInfo.HF_extendLength 99 Selection.TypeParagraph 100 ELength = ELength + Selection.Characters.First.Font.Size 101 Wend 102 End If 103 104 If Snum <> 0 Then 105 I = 0 106 For Each myshape In myPrepInfo.HF_Shapes 107 If myshape.Type = msoPicture Then 108 If myshape.RelativeVerticalPosition <> wdRelativeVerticalPositionPage Then 109 temptop = myshape.top + myshape.Anchor.Information(wdVerticalPositionRelativeToPage) 110 Else 111 temptop = myshape.top 112 End If 113 ElseIf myshape.Type = msoTextBox Then 114 myshape.TextFrame.TextRange.Select 115 116 temptop = Selection.Information(wdVerticalPositionRelativeToPage) 117 End If 118 Selection.GoTo what:=wdGoToPage, Which:=wdGoToAbsolute, _ 119 count:=myPrepInfo.HF_OnPage 120 If myPrepInfo.HF_inheader Then 121 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader 122 Else 123 currDoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 124 End If 125 Selection.HeaderFooter.Shapes(myshape.name).Select 126 Selection.ShapeRange.IncrementTop shapetop(I) - temptop 127 I = I + 1 128 Next myshape 129 End If 130 ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 131 Prepare_HeaderFooter_GraphicFrames = True 132FinalExit: 133 Exit Function 134 135HandleErrors: 136 WriteDebug currentFunctionName & " : " & docAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 137 Resume FinalExit 138End Function 139 140'Stub for Excel Prepare SheetName 141Function Prepare_WorkbookVersion() As Boolean 142 Prepare_WorkbookVersion = False 143End Function 144 145 146