MS Word2003: How to obtain range size?

Posted on 2004-08-08
Last Modified: 2011-11-18
[Environment: MS Word2003, Visual Studio 2003.]

I'm writing C# MS Word addin.

I can't find in Word Basic documentation how to calculate size (for example in points, measurement does not matter) of some range of text. There is a property called "FitTextWidth" but appeas it does not work - it always return 0 for any range. It also would be OK if I know width of just one character.

Please help!
Question by:long8
LVL 22

Accepted Solution

DarkoLord earned 500 total points
ID: 11751273
Hello.. Try this:

Option Explicit

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Const LF_FACESIZE = 32
Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * LF_FACESIZE
End Type

        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

Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function apiDeleteObject Lib "gdi32" Alias "DeleteObject" (ByVal hObject As Long) As Long
Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Long, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
Private Declare Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hwnd As Long) As Long
Private Declare Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As Long, ByVal lpInitData As Long) As Long  'DEVMODE) As Long
Private Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" (ByVal hDC As Long) As Long

Private Const TWIPSPERINCH = 1440
' Used to ask System for the Logical pixels/inch in X & Y axis
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88
' DrawText() Format Flags
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_EDITCONTROL = &H2000&
Private Const DT_NOCLIP = &H100

' Font stuff
Private Const OUT_DEFAULT_PRECIS = 0
Private Const OUT_STRING_PRECIS = 1
Private Const OUT_STROKE_PRECIS = 3
Private Const OUT_TT_PRECIS = 4
Private Const OUT_DEVICE_PRECIS = 5
Private Const OUT_RASTER_PRECIS = 6
Private Const OUT_TT_ONLY_PRECIS = 7
Private Const OUT_OUTLINE_PRECIS = 8

Private Const CLIP_STROKE_PRECIS = 2
Private Const CLIP_MASK = &HF
Private Const CLIP_LH_ANGLES = 16
Private Const CLIP_TT_ALWAYS = 32
Private Const CLIP_EMBEDDED = 128

Private Const DEFAULT_QUALITY = 0
Private Const DRAFT_QUALITY = 1
Private Const PROOF_QUALITY = 2

Private Const DEFAULT_PITCH = 0
Private Const FIXED_PITCH = 1
Private Const VARIABLE_PITCH = 2

Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const CHINESEBIG5_CHARSET = 136
Private Const OEM_CHARSET = 255

 Public Function fTextWidthOrHeight(ctl As Control, ByVal blWH As Boolean, _
 Optional ByVal sText As String = "", _
 Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
 Optional TotalLines As Long = 0, _
 Optional TwipsPerPixel As Long = 0) As Long
 'Created by:            Stephen Lebans

 '***************Code Start***************
 ' Structure for DrawText calc
 Dim sRect As RECT
 ' Reports Device Context
 Dim hDC As Long
 ' Holds the current screen resolution
 Dim lngDPI As Long
 Dim newfont As Long
 ' Handle to our Font Object we created.
 ' We must destroy it before exiting main function

 Dim oldfont As Long
 ' Device COntext's Font we must Select back into the DC
 ' before we exit this function.
 ' Temporary holder for returns from API calls
 Dim lngRet As Long
 ' Logfont struct
 Dim myfont As LOGFONT
 ' TextMetric struct
 ' LineSpacing Amount
 Dim lngLineSpacing As Long
 ' Ttemp var
 Dim numLines As Long
 ' Temp string var for current printer name
 Dim strName As String
 ' Temp vars
 Dim sngTemp1 As Single
 Dim sngTemp2 As Single
 On Error GoTo Err_Handler
    hDC = apiGetDC(0&)
 ' Get current device resolution
 ' blWH=TRUE then we are TextHeight
 If blWH Then
     lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSY)
     lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSX)
 End If

' Calculate TwipsPerPixel
TwipsPerPixel = TWIPSPERINCH / lngDPI

 ' We use a negative value to signify
 ' to the CreateFont function that we want a Glyph
 ' outline of this size not a bounding box.
 ' Copy font stuff from Text Control's property sheet
 With ctl
     myfont.lfClipPrecision = CLIP_LH_ANGLES
     myfont.lfOutPrecision = OUT_TT_ONLY_PRECIS
     myfont.lfEscapement = 0
     myfont.lfFaceName = .FontName & Chr$(0)
     'myfont.lfWeight = .FontWeight
     myfont.lfItalic = .FontItalic
     myfont.lfUnderline = .FontUnderline
     'Must be a negative figure for height or system will return
     'closest match on character cell not glyph
     myfont.lfHeight = (.FontSize / 72) * -lngDPI
     ' Create our temp font
     newfont = apiCreateFontIndirect(myfont)
 End With
     If newfont = 0 Then
         Err.Raise vbObjectError + 256, "fTextWidthOrHeight", "Cannot Create Font"
     End If

 ' Select the new font into our DC.
 oldfont = apiSelectObject(hDC, newfont)
 ' Use DrawText to Calculate height of Rectangle required to hold
 ' the current contents of the Control passed to this function.
 With sRect
   .Left = 0
   .Top = 0
   .Bottom = 0
   ' blWH=TRUE then we are TextHeight
   If blWH Then
     .Right = (ctl.Width / (TWIPSPERINCH / lngDPI)) - 10
   ' Single line TextWidth
     .Right = 32000
   End If
   ' Calculate our bounding box based on the controls current width
   lngRet = apiDrawText(hDC, sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
   ' Get TextMetrics. This is required to determine
   ' Text height and the amount of extra spacing between lines.
   lngRet = GetTextMetrics(hDC, tm)
   ' Cleanup
   lngRet = apiSelectObject(hDC, oldfont)
   ' Delete the Font we created
   apiDeleteObject (newfont)
  'If TypeOf ctl.Parent Is Access.Report Then
    ' ***************************************************
    ' If you are using the Printers' DC then uncomment below
    ' and comment out the apiReleaseDc line of code below
    ' Delete our handle to the Printer DC
  '  lngRet = apiDeleteDC(hDC)
    ' ***************************************************
    ' Release the handle to the Screen's DC
    lngRet = apiReleaseDC(0&, hDC)
  'End If
 ' Calculate how many lines we are displaying
 ' return to calling function. The GDI incorrectly
 ' calculates the bounding rectangle because
 ' of rounding errors converting to Integers.
 TotalLines = .Bottom / (tm.tmHeight + tm.tmExternalLeading)
 numLines = TotalLines
 ' Convert RECT values to TWIPS
 .Bottom = (.Bottom) * (TWIPSPERINCH / lngDPI) 'sngTemp2 ' + 20
   ' Return values in optional vars
   ' Convert RECT Pixel values to TWIPS
   HeightTwips = .Bottom '* (TWIPSPERINCH / lngDPI)
   WidthTwips = .Right * (TWIPSPERINCH / lngDPI) '(apiGetDeviceCaps(hDC, LOGPIXELSX)))
   ' blWH=TRUE then we are TextHeight
   If blWH Then
     fTextWidthOrHeight = HeightTwips
    fTextWidthOrHeight = WidthTwips
   End If
End With

' Exit normally
Exit Function

Err.Raise Err.Source, Err.Number, Err.Description
Resume Exit_OK
End Function


Author Comment

ID: 12469960
Using WinAPI I can do this myself. I was looking for a MS Word native solution. Anyway thank you for the reply.

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In a recent article ( for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now