LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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

 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Header and Footer margins Lenny Excel Discussion (Misc queries) 1 August 8th 09 12:37 AM
Need help setting the worksheet header/Footer margins based on string height? Doug Excel Discussion (Misc queries) 0 August 20th 06 02:05 AM
Header/Footer side margins GDC Excel Discussion (Misc queries) 1 October 21st 05 12:27 AM
MACRO FOR SETTING MARGINS WITHOUT OVERRIDING HEADER AND FOOTER Ro Excel Discussion (Misc queries) 0 March 30th 05 02:31 PM
Left/Right Margins in Header/Footer BobB Excel Discussion (Misc queries) 1 November 29th 04 09:04 PM


All times are GMT +1. The time now is 10:35 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"