vb macro string width in pixel

Question

How would you calculate the number of pixels for a String (in an arbitrary font), using an Excel VBA macro?

Related:

• http://www.mrexcel.com/forum/excel

Answer 1

I put this code on a timer and ran it every second, then opened up Task Manager and enabled the GDI Objects column. I could see it keep on increasing for my process.

Although tempDC is being deleted, I think the result of GetDC(0) needs to be as well?

(This is in relation to the accepted answer btw)

This slight adjustment worked for me:

...

Private Function GetLabelSize(text As String, font As StdFont) As SIZE
    Dim tempDC As Long
    Dim tempDC2 As Long
    Dim tempBMP As Long
    Dim f As Long
    Dim lf As LOGFONT
    Dim textSize As SIZE

    ' Create a device context and a bitmap that can be used to store a
    ' temporary font object
    tempDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0)
    tempBMP = CreateCompatibleBitmap(tempDC, 1, 1)

    ' Assign the bitmap to the device context
    DeleteObject SelectObject(tempDC, tempBMP)

    ' Set up the LOGFONT structure and create the font
    lf.lfFaceName = font.Name & Chr$(0)
    tempDC2 = GetDC(0)
    lf.lfHeight = -MulDiv(font.SIZE, GetDeviceCaps(tempDC2, 90), 72) 'LOGPIXELSY
    lf.lfItalic = font.Italic
    lf.lfStrikeOut = font.Strikethrough
    lf.lfUnderline = font.Underline
    If font.Bold Then lf.lfWeight = 800 Else lf.lfWeight = 400
    f = CreateFontIndirect(lf)

    ' Assign the font to the device context
    DeleteObject SelectObject(tempDC, f)

    ' Measure the text, and return it into the textSize SIZE structure
    GetTextExtentPoint32 tempDC, text, Len(text), textSize

    ' Clean up (very important to avoid memory leaks!)
    DeleteObject f
    DeleteObject tempBMP
    DeleteDC tempDC
    DeleteDC tempDC2

  ' Return the measurements
    GetLabelSize = textSize

End Function