Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.misc
|
|||
|
|||
![]()
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 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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
How do I adjust row height to set cell margins to zero? | Excel Discussion (Misc queries) | |||
List File Properties - Author | Excel Worksheet Functions | |||
Copying data from one worksheet to another based on criteria | Excel Discussion (Misc queries) | |||
Vary column width and row height in the same worksheet | Excel Discussion (Misc queries) | |||
Setting Default Row Height | Setting up and Configuration of Excel |