TextWidth in VBA

[SimonFinn]

Hi Guys

Ive been having a nightmare trying to measure the pixel width of a string so that i can resize my MSFlexGrid in MS Access 2000.

Access 2000/VBA does not support the printer object therefore does not support TextWidth.

Ive been playing with APIs but i have not got it to work successfully.

Does anyone know an alternative or have a Wrapper that i can look at so that i can get the picture?

Thanks Si

 

[MarkSweetland]

I have to give credit to someone else on this (zemp?) But this works for me in VB6, maybe have to modify for VBA?


Public Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" (ByVal hDC As Long, _
ByVal lpsz As String, ByVal cbString As Long, _
lpSize As Size) As Long

Public Type Size
cx As Long
cy As Long
End Type

Public Sub FGResizeCol(frm As Object, fg As MSFlexGrid, col As Integer)
Const COLUMN_INSIDE_MARGIN = 90 'twips
Dim fieldwidth, fieldValueHighText As String, i As Integer
fieldwidth = 0
If fg.Rows > 0 Then
For i = 0 To fg.Rows - 1
If GetPTextWidth(frm, fg.TextMatrix(i, col)) > fieldwidth Then
fieldwidth = GetPTextWidth(frm, fg.TextMatrix(i, col))
fieldValueHighText = fg.TextMatrix(i, col)
End If
Next
Dim inContentWidth As Integer
inContentWidth = GetPTextWidth(frm, fieldValueHighText)
fg.ColWidth(col) = inContentWidth + 150
End If
End Sub

Public Function GetPTextWidth(frm As Object, strTest As String) As Long

'calculate length of text in twips
Dim lngRV As Long
Dim cellSize As Size
Dim lngX As Long
Dim lnHeight As Long

lngRV = GetTextExtentPoint32(frm.hDC, strTest, Len(strTest), cellSize)

With cellSize
GetPTextWidth = .cx * Screen.TwipsPerPixelX
lnHeight = .cy * Screen.TwipsPerPixelY
End With

If GetPTextWidth < 500 Then GetPTextWidth = 500

End Function

Public Function GetPTextHeight(frm As Object, strTest As String) As Long

'calculate Height of text in twips
Dim lngRV As Long
Dim cellSize As Size
Dim lngX As Long
Dim lnHeight As Long

lngRV = GetTextExtentPoint32(frm.hDC, strTest, Len(strTest), cellSize)

With cellSize
lngX = .cx * Screen.TwipsPerPixelX
GetPTextHeight = .cy * Screen.TwipsPerPixelY
End With

If GetPTextHeight < 225 Then GetPTextHeight = 225

End Function

Mark

 

[SimonFinn]

Hi Mark

Thanks for the code, it has helped me a lot, but:

Im using this code and i have modified it to fit my project and VBA. I have added another call to get the screen object that is not supported in VBA.

But i have a problem with the GetPTextWidth Function. I have changed the frm Object to the name of the form that the FlexiGrid is located in. I get the error Run-Time error '2465' Application-Defined or or object-defined error.

This is on the row:

lngRV = GetTextExtentPoint32(Form_frmSearch.hdc, strTest, Len(strTest), cellSize)

within the GetPTextWidth Function

Have u any ideas why this is??

Thanks Si