Need help setting the worksheet header/Footer margins based on string height?

I need to programicaly change the worksheet top and bottom margins if
the header or footer text height is larger then the available space.

Lets say the user sets the default top margin to 1 inch but wants to
display two lines of text in Times New Roman font size 26. Now this
needs more room than a 1 inch margin. So I want to get the text height
and set the top or bottom margin.

I am getting the string height like this:

Dim strSize as size
Dim strHeight as single
Dim numLines as single
numLines= getNumLines(sString)
strSize= GetStringSize(sString,fntName,fntSize)
strHeight=strSize.cy * numLines
ActiveSheet.pagesetup.TopMargin=strHeight

For the above example the strHeight is 80 points or 1.11 inches which
is too small. So I thought that I needed to add the line spacing to
the equation. I found an article on MSDN that the default Windows line
spacing is tmHeight - tmExternalLeading but when I tried this the
result is way too big.

I have also tried:
1. Adding the printers hard margin to the equation
2. Tried to pass a printer device context to the GetTextExtentPoint32
function
3. Tried creating a TextBox object with auto size and get the height

Nothing I've tried is working. Does any one know what I'm doing
wrong?

Here is some test code the reports the string height

Public Type size
cx As Long
cy As Long
End Type

Public Const LOGPIXELSX = 88 ' Logical pixels/inch in X
Public Const LOGPIXELSY = 90 ' Logical pixels/inch in Y

Public Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type

'Device caps constants
Global Const DRIVERVERSION = 0
Global Const TECHNOLOGY = 2
Global Const HORZSIZE = 4
Global Const VERTSIZE = 6
Global Const HORZRES = 8
Global Const VERTRES = 10
Global Const BITSPIXEL = 12
Global Const PLANES = 14
Global Const NUMBRUSHES = 16
Global Const NUMPENS = 18
Global Const NUMMARKERS = 20
Global Const NUMFONTS = 22
Global Const NUMCOLORS = 24
Global Const PDEVICESIZE = 26
Global Const CURVECAPS = 28
Global Const LINECAPS = 30
Global Const POLYGONALCAPS = 32
Global Const TEXTCAPS = 34
Global Const CLIPCAPS = 36
Global Const RASTERCAPS = 38
Global Const ASPECTX = 40
Global Const ASPECTY = 42
Global Const ASPECTXY = 44
Global Const PHYSICALWIDTH = 110
Global Const PHYSICALHEIGHT = 111
Global Const PHYSICALOFFSETX = 112
Global Const PHYSICALOFFSETY = 113
Global Const SCALINGFACTORX = 114
Global Const SCALINGFACTORY = 115

Public Declare Function GetTextMetrics Lib "gdi32" Alias
"GetTextMetricsA" ( _
ByVal hdc As Long, lpMetrics As TEXTMETRIC) As Long

Public Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" ( _
ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal
lpOutput As Long, _
ByVal lpInitData As Long) As Long

Public Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As
Long

Public Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" ( _
ByVal nHeight As Long, ByVal nWidth As Long, ByVal nEscapement As
Long, _
ByVal nOrientation As Long, ByVal fnWeight As Long, ByVal fdwItalic
As Long, _
ByVal fdwUnderline As Long, ByVal fdwStrikeOut As Long, ByVal
fdwCharSet As Long, _
ByVal fdwOutputPrecision As Long, ByVal fdwClipPrecision As Long, _
ByVal fdwQuality As Long, ByVal fdwPitchAndFamily As Long, ByVal
lpszFace As String) As Long

Public Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Public Declare Function SelectObject Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal hObject As Long) As Long

Public Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long

Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias
"GetTextExtentPoint32A" _
(ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As size) As Long

Function getNumLines(text As String, Optional delim As String) As
Integer
If Len(delim) = 0 Then
delim = Chr(10)
End If
n = Split(text, delim)
getNumLines = UBound(n) + 1
End Function
Public Function GetStringSize(sString As String, sFontName As String,
fPointSize As Single) As size
Dim fnt As Font
Dim iFontSize As Long
Dim hdc As Long
Dim hFont As Long, hFontOld As Long
Dim Metrics As TEXTMETRIC
Dim fPixelsPerPoint As Single
Dim stringSize As size

'Create a Device Context, pretending we wanted to
'write into it:
hdc = CreateDC("DISPLAY", vbNullString, 0, 0)

'turn the nominal font size (in points) into
'a device-specific size in pixels:
fPixelsPerPoint = GetDeviceCaps(hdc, LOGPIXELSY) / 72
iFontSize = fPointSize * fPixelsPerPoint

'Prepare a font for printing into the Device Context:
hFont = CreateFont(-iFontSize, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
sFontName)
hFontOld = SelectObject(hdc, hFont)

GetTextExtentPoint32 hdc, sString, Len(sString), stringSize
GetStringSize = stringSize

'Tidy up:
SelectObject hdc, hFontOld
DeleteObject hFont
DeleteDC hdc
End Function
Sub testStringHeight()

Dim strSize As size
Dim strHeight As Single
Dim numLines As Single
Dim sString As String
Dim fntName As String
Dim fntSize As Single

fntName = "Times New Roman"
fntSize = 26
sString = "Line1" & Chr(10) & "Line2"

numLines = getNumLines(sString)
strSize = GetStringSize(sString, fntName, fntSize)
strHeight = strSize.cy * numLines
MsgBox strHeight

End Sub

Should I be posting this question in a diferent newgroup?

With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(1.2) '<==
.RightMargin = Application.InchesToPoints()
.TopMargin = Application.InchesToPoints()
.BottomMargin = Application.InchesToPoints()
.HeaderMargin = Application.InchesToPoints()
.FooterMargin = Application.InchesToPoints()
End With

--
Regards,
Tom Ogilvy


"Doug" <[email protected]> wrote in message
news:[email protected]...
> Should I be posting this question in a diferent newgroup?
>

I was able to improve the results by adding the value of HeaderMargin
and FooterMargin to the strings height but it's sill not 100% perfect.

It's almost perfect for 1 or two lines but for 3 or more the
strHeight+HeaderMargin starts to get too big.

Anyone have any Ideas?

This is part of a macro to transform a set of cross tabs to charts.

Doug