This won't give you the exact width, but it will give the relative width, so
maybe it could help you out.
Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect _
Lib "user32" (ByVal hwnd As Long, _
lpRect As RECT) As Long
Private Declare Function GetTextExtentPoint32 _
Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As POINTAPI) As Long
Private Declare Function GetWindowDC _
Lib "user32" (ByVal hwnd As Long) As Long
Function GetTextSize(strText As String) As Long()
Dim lHwnd As Long
Dim WR As RECT
Dim lDC As Long
Dim TextSize As POINTAPI
Dim Result(1 To 2) As Long
'get the Excel application hWnd
'This may need to be a different hWnd
lHwnd = Application.hwnd
'Get the window's position
GetWindowRect lHwnd, WR
'Get the window's device context
lDC = GetWindowDC(lHwnd)
'Get the height and width of our text
GetTextExtentPoint32 lDC, strText, Len(strText), TextSize
Result(1) = TextSize.X
Result(2) = TextSize.Y
GetTextSize = Result
End Function
Sub test()
Dim arr
arr = GetTextSize(String(10, "w"))
MsgBox "text width: " & arr(1) & vbCrLf & _
"text height: " & arr(2), , String(10, "w")
arr = GetTextSize(String(10, "i"))
MsgBox "text width: " & arr(1) & vbCrLf & _
"text height: " & arr(2), , String(10, "i")
End Sub
RBS