Solved: Getting the "usable" page height?

[Adamski]

Hi all,

I have a problem which I thought would be trivial but have not yet managed to solve. I would like to find out the height of the current page body in Word 2003 - the bit between the top and bottom margins, taking any headers and footers of the section into account. This is so I can modify image dimensions.

This is some test code to to try and size InlineShapes to the page.

Sub SetInlineShapeSize()

Dim CurrentInlineShape As InlineShape
Dim StartInlineShapeRange As Range

For Each CurrentInlineShape In ActiveDocument.InlineShapes

' Get page that the image will end up on
Set StartInlineShapeRange = CurrentInlineShape.Range
StartInlineShapeRange.Collapse (wdCollapseStart)

' Get the properties of the page (I think this is wrong)
With StartInlineShapeRange.PageSetup
Dim maxW As Double: maxW = (.PageWidth - .LeftMargin - .RightMargin)
Dim maxH As Double: maxH = (.PageHeight - .TopMargin - .BottomMargin - .FooterDistance - .HeaderDistance)
End With

' Set picture size
CurrentInlineShape.Width = maxW
CurrentInlineShape.Height = maxH

Set StartInlineShapeRange = Nothing

Next CurrentInlineShape

End Sub

Maybe "- .Gutter" should be in there too.

The height of an InlineShape it is clearly incorrect - sometimes the image is too tall and doesn't fit, sometimes it is too small and text lines can follow the picture on the same page. It seems to depend on how the Headers and Footers are set up but how? Maybe the view and printer come into it too.

Edit:
I have just considered that I may be getting the wrong heights if different odd/even page headers/footers are set up. Or maybe they expand to their content without affecting the PageSetup.FooterDistance and PageSetup.HeaderDistance settings.

It would be nice to optionally have one line below the image for a caption.

Any ideas appreciated. Thanks,
Adam

[Adamski]

No replys! I thaught it would be fairly easy - guess not.

I can't edit my first post but I wanted to give you an update on where I've got to in the hope that somebody can help. Put an InlineShape in a Word 2003 Document and run this code to expand it to fill the page body.


Sub MaximizeInlineShapes()

Dim ObjInlineShape As InlineShape

Dim ObjInlineShapeRange As Range
Dim IntSectionIndex As Double

Dim ObjHeaderRange As Range
Dim IntHeaderPos As Double

Dim ObjFooterRange As Range
Dim IntFooterPos As Double

For Each ObjInlineShape In ActiveDocument.InlineShapes

' Get start of image
Set ObjInlineShapeRange = ObjInlineShape.Range
ObjInlineShapeRange.Collapse (wdCollapseStart)

' Get the section index
IntSectionIndex = ObjInlineShapeRange.Information(wdActiveEndSectionNumber)

'Get the start of the next page vertical pos (expanded by content)
ObjInlineShapeRange.GoToNext (wdGoToPage)
IntHeaderPos = ObjInlineShapeRange.Information(wdVerticalPositionRelativeToPage)

' Get the footer start pos
Set ObjFooterRange = ActiveDocument.Sections(IntSectionIndex).Footers(wdHeaderFooterPrimary).Ran ge
ObjFooterRange.Collapse (wdCollapseStart)
IntFooterPos = ObjFooterRange.Information(wdVerticalPositionRelativeToPage)
'MsgBox IntHeaderPos

' Get the header and footer properties of the page
With ObjInlineShapeRange.PageSetup

If .TopMargin < .HeaderDistance Then
If IntHeaderPos < .HeaderDistance Then
' only seem to get here if the header is empty
IntHeaderPos = .HeaderDistance ' + Header Style Text height + 1
End If
End If

If IntFooterPos > .PageHeight - (.BottomMargin) Then
IntFooterPos = .PageHeight - (.BottomMargin)
End If

Dim IntPageWidth As Double: IntPageWidth = (.PageWidth - .LeftMargin - .RightMargin)

End With

Dim IntPageHeight As Double: IntPageHeight = IntFooterPos - IntHeaderPos

' Set picture size
ObjInlineShape.Width = IntPageWidth
ObjInlineShape.Height = IntPageHeight

Set ObjInlineShapeRange = Nothing

Next ObjInlineShape

End Sub


The code works for:
FooterDistance < BottomMargin
FooterDistance > BottomMargin
Footer expanded by its contents
HeaderDistance < TopMargin
Header expanded by its contents

but not:
HeaderDistance > TopMargin (with empty header)

also, it causes headers and footer to show when they are not.

[fumei]

Whew. I am having a hard time following this, but it seems that the majority of the content of your document is not text, but graphics (InlineShapes). Is this correct?

And are you trying to take individual graphical elements (your InlineShapes) and dynamically resize them to fit the page they are on?

[Adamski]

Sorry I didn't get back to you yesterday - I didn't check the forums.

All I really want to find out is the height and width of a particular page.

I am exporting data from a DOORS database which allows users to insert OLE objects but unfortunatly handles them badly once they are in. When I export them to word via application automation written in its own language (DXL), they end up with completly the wrong dimensions, and wrong aspect ratio. I am therefore getting the original dimensions before the export to use to size and scale them afterwards. In order to do that I need to know the maximum dimensions which will fit a page.

I have been maximising InlineShapes as a way to test my code, as it is then clear when I get the correct dimensions.

I hope that makes sense! Here is the code as far as I have got now - it's working well although I haven't tested with PageSetup.MarginPos:

Option Explicit

Sub MaximizeInlineShapes()

Dim ObjInlineShape As InlineShape
Dim ObjInlineShapeRange As Range

Dim IntSectionIndex As Double
Dim ObjSection As Section
Dim ObjSectionRange As Range
Dim IntSectionPageNumber As Double
Dim IntSection1Orientation As Double

Dim IntHeaderFooterType As Double
Dim IntPageNumber As Double

Dim IntTopMarginPos As Double
Dim IntBottomMarginPos As Double

Dim ObjFirstLineRange As Range
Dim IntFirstLinePos As Double

Dim BoolHeaderIsEmpty As Boolean
Dim ObjHeaderRange As Range
Dim IntHeaderPos As Double

Dim BoolFooterIsEmpty As Boolean
Dim ObjFooterRange As Range
Dim IntFooterPos As Double

Dim IntBodyWidth As Double
Dim IntBodyHeight As Double

For Each ObjInlineShape In ActiveDocument.InlineShapes

' Get start of image
Set ObjInlineShapeRange = ObjInlineShape.Range
ObjInlineShapeRange.Collapse (wdCollapseStart)

' Get page number of image
IntPageNumber = ObjInlineShapeRange.Information(wdActiveEndPageNumber)

' Get the section of image
IntSectionIndex = ObjInlineShapeRange.Information(wdActiveEndSectionNumber)
Set ObjSection = ActiveDocument.Sections(IntSectionIndex)
Set ObjSectionRange = ObjSection.Range
ObjSectionRange.Collapse (wdCollapseStart)
IntSectionPageNumber = ObjSectionRange.Information(wdActiveEndPageNumber)

' Section 1 Orientation
IntSection1Orientation = ActiveDocument.Sections(1).PageSetup.Orientation

' Get the Section PageSetup data
With ObjSection.PageSetup

' The values work differently depending on section 1 orientation!
If IntSection1Orientation = wdOrientPortrait Then

If .Orientation = wdOrientPortrait Then

' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin

Else
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin

' Save height data for later
IntTopMarginPos = .TopMargin + .Gutter
IntBottomMarginPos = .PageHeight - .BottomMargin

End If

Else

If .Orientation = wdOrientPortrait Then

' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin - .Gutter

Else
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin

End If
End If


End With

'Get the first line of the page vertical position
Set ObjFirstLineRange = ObjInlineShapeRange.GoTo(wdGoToPage, wdGoToAbsolute, IntPageNumber)
IntFirstLinePos = ObjFirstLineRange.Information(wdVerticalPositionRelativeToPage)

' Get the correct header/footer
IntHeaderFooterType = wdHeaderFooterPrimary
If ObjSection.Headers(wdHeaderFooterFirstPage).Exists And IntPageNumber = IntSectionPageNumber Then
IntHeaderFooterType = wdHeaderFooterFirstPage
ElseIf ObjSection.Headers(wdHeaderFooterEvenPages).Exists Then
If IntPageNumber Mod 2 = 0 Then
IntHeaderFooterType = wdHeaderFooterEvenPages
End If
End If

' Get the section header vertical position
BoolHeaderIsEmpty = IsEmptyHeaderOrFooter(IntSectionIndex, True, IntHeaderFooterType)
Set ObjHeaderRange = ObjSection.Headers(IntHeaderFooterType).Range
If BoolHeaderIsEmpty Then
IntHeaderPos = IntTopMarginPos
Else
IntHeaderPos = IntFirstLinePos
End If

' Get the section footer vertical position
BoolFooterIsEmpty = IsEmptyHeaderOrFooter(IntSectionIndex, False, IntHeaderFooterType)
Set ObjFooterRange = ObjSection.Footers(IntHeaderFooterType).Range
If BoolFooterIsEmpty Then
IntFooterPos = IntBottomMarginPos
Else
ObjFooterRange.Collapse (wdCollapseStart)
IntFooterPos = ObjFooterRange.Information(wdVerticalPositionRelativeToPage)
'MsgBox "Not Empty: " & IntFooterPos
If (IntFooterPos > IntBottomMarginPos) Then
IntFooterPos = IntBottomMarginPos
End If
End If

' Calculate body height
IntBodyHeight = IntFooterPos - IntHeaderPos

' Set picture size if > 0
If IntBodyWidth > 0 Then
ObjInlineShape.Width = IntBodyWidth
End If

If IntBodyHeight > 0 Then
ObjInlineShape.Height = IntBodyHeight
End If

Next
End Sub

Function IsEmptyHeaderOrFooter(IntSectionIndex As Double, IsAHeader As Boolean, HeaderFooterType As Double) As Boolean

' For Microsoft Word 2003
' Empty Headers and Footers in section 1 are not displayed.
' Headers and Footers in other sections are displayed even if empty, unless...
' They are in a Linked To Previous chain which ends in an empty setion 1 Header or Footer

Dim ObjSection As Section
Set ObjSection = ActiveDocument.Sections(IntSectionIndex)


Dim ObjHeaderOrFooter As HeaderFooter
If IsAHeader Then
Set ObjHeaderOrFooter = ObjSection.Headers(HeaderFooterType)
Else
Set ObjHeaderOrFooter = ObjSection.Footers(HeaderFooterType)
End If


If ObjHeaderOrFooter.LinkToPrevious Then
IsEmptyHeaderOrFooter = IsEmptyHeaderOrFooter(IntSectionIndex - 1, IsAHeader, HeaderFooterType)
Else
If (ObjHeaderOrFooter.Range.Characters.Count <= 1) And (IntSectionIndex = 1) Then
IsEmptyHeaderOrFooter = True
Else
IsEmptyHeaderOrFooter = False
End If
End If


End Function
Thanks for taking the time to have a look and reply,
Adam

Edit: I am now translating to DXL for my exporter.

[Adamski]

Here is the final function for completeness:

Sub MaximizeInlineShapes()

Dim ObjInlineShape As InlineShape
Dim ObjInlineShapeRange As Range

Dim IntSectionIndex As Double
Dim ObjSection As Section
Dim ObjSectionRange As Range
Dim IntSectionPageNumber As Double
Dim IntSection1Orientation As Double

Dim IntHeaderFooterType As Double
Dim IntPageNumber As Double

Dim IntTopMarginPos As Double
Dim IntBottomMarginPos As Double

Dim ObjFirstLineRange As Range
Dim IntFirstLinePos As Double

Dim BoolHeaderIsEmpty As Boolean
Dim IntHeaderPos As Double

Dim BoolFooterIsEmpty As Boolean
Dim ObjFooterRange As Range
Dim IntFooterPos As Double

Dim IntBodyWidth As Double
Dim IntBodyHeight As Double

For Each ObjInlineShape In ActiveDocument.InlineShapes

' Get start of image
Set ObjInlineShapeRange = ObjInlineShape.Range
ObjInlineShapeRange.Collapse (wdCollapseStart)

' Get page number of image
IntPageNumber = ObjInlineShapeRange.Information(wdActiveEndPageNumber)

' Get the section of image
IntSectionIndex = ObjInlineShapeRange.Information(wdActiveEndSectionNumber)
Set ObjSection = ActiveDocument.Sections(IntSectionIndex)
Set ObjSectionRange = ObjSection.Range
ObjSectionRange.Collapse (wdCollapseStart)
IntSectionPageNumber = ObjSectionRange.Information(wdActiveEndPageNumber)

' Section 1 Orientation
IntSection1Orientation = ActiveDocument.Sections(1).PageSetup.Orientation

' Get the Section PageSetup data
With ObjSection.PageSetup

' The values work differently depending on section 1 orientation!
If IntSection1Orientation = wdOrientPortrait Then
If .Orientation = wdOrientPortrait Then
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin

If (.GutterPos = wdGutterPosTop) Then
IntBodyWidth = IntBodyWidth + .Gutter
IntTopMarginPos = IntTopMarginPos + .Gutter
End If

Else
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin

' Save height data for later
IntTopMarginPos = .TopMargin + .Gutter
IntBottomMarginPos = .PageHeight - .BottomMargin

If (.GutterPos = wdGutterPosTop) Then
IntBodyWidth = IntBodyWidth - .Gutter
IntTopMarginPos = IntTopMarginPos - .Gutter
End If

End If
Else
If .Orientation = wdOrientPortrait Then
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin - .Gutter

If (.GutterPos = wdGutterPosTop) Then
IntBodyWidth = IntBodyWidth - .Gutter
IntBottomMarginPos = IntBottomMarginPos + .Gutter
End If

Else
' Calculate body width
IntBodyWidth = .PageWidth - .LeftMargin - .RightMargin - .Gutter

' Save height data for later
IntTopMarginPos = .TopMargin
IntBottomMarginPos = .PageHeight - .BottomMargin

If (.GutterPos = wdGutterPosTop) Then
IntBodyWidth = IntBodyWidth + .Gutter
IntTopMarginPos = IntTopMarginPos + .Gutter
End If

End If
End If

End With

'Get the first line of the page vertical position
Set ObjFirstLineRange = ObjInlineShapeRange.GoTo(wdGoToPage, wdGoToAbsolute, IntPageNumber)
IntFirstLinePos = ObjFirstLineRange.Information(wdVerticalPositionRelativeToPage)

' Get the correct header/footer
IntHeaderFooterType = wdHeaderFooterPrimary
If ObjSection.Headers(wdHeaderFooterFirstPage).Exists And IntPageNumber = IntSectionPageNumber Then
IntHeaderFooterType = wdHeaderFooterFirstPage
ElseIf ObjSection.Headers(wdHeaderFooterEvenPages).Exists Then
If IntPageNumber Mod 2 = 0 Then
IntHeaderFooterType = wdHeaderFooterEvenPages
End If
End If

' Get the section header vertical position
BoolHeaderIsEmpty = IsEmptyHeaderOrFooter(IntSectionIndex, True, IntHeaderFooterType)
If BoolHeaderIsEmpty Then
IntHeaderPos = IntTopMarginPos
Else
IntHeaderPos = IntFirstLinePos
End If

' Get the section footer vertical position
BoolFooterIsEmpty = IsEmptyHeaderOrFooter(IntSectionIndex, False, IntHeaderFooterType)
Set ObjFooterRange = ObjSection.Footers(IntHeaderFooterType).Range
If BoolFooterIsEmpty Then
IntFooterPos = IntBottomMarginPos
Else
ObjFooterRange.Collapse (wdCollapseStart)
IntFooterPos = ObjFooterRange.Information(wdVerticalPositionRelativeToPage)

IntFooterPos = IntFooterPos - ObjFooterRange.ParagraphFormat.SpaceBefore

'MsgBox "End: " & ObjFooterRange.End & " Vert: " & IntFooterPos
If (IntFooterPos > IntBottomMarginPos) Then
IntFooterPos = IntBottomMarginPos
End If
End If

' Calculate body height
IntBodyHeight = IntFooterPos - IntHeaderPos

' Set picture size if > 0
If IntBodyWidth > 0 Then
ObjInlineShape.Width = IntBodyWidth
End If

If IntBodyHeight > 0 Then
ObjInlineShape.Height = IntBodyHeight
End If

Next
End Sub

Function IsEmptyHeaderOrFooter(IntSectionIndex As Double, IsAHeader As Boolean, HeaderFooterType As Double) As Boolean

' For Microsoft Word 2003
' Empty Headers and Footers in section 1 are not displayed.
' Headers and Footers in other sections are displayed even if empty, unless...
' They are in a Linked To Previous chain which ends in an empty setion 1 Header or Footer

Dim ObjSection As Section
Set ObjSection = ActiveDocument.Sections(IntSectionIndex)


Dim ObjHeaderOrFooter As HeaderFooter
If IsAHeader Then
Set ObjHeaderOrFooter = ObjSection.Headers(HeaderFooterType)
Else
Set ObjHeaderOrFooter = ObjSection.Footers(HeaderFooterType)
End If


If ObjHeaderOrFooter.LinkToPrevious Then
IsEmptyHeaderOrFooter = IsEmptyHeaderOrFooter(IntSectionIndex - 1, IsAHeader, HeaderFooterType)
Else
If (ObjHeaderOrFooter.Range.Characters.Count <= 1) And (IntSectionIndex = 1) Then
IsEmptyHeaderOrFooter = True
Else
IsEmptyHeaderOrFooter = False
End If
End If


End Function