My ultimate goal is to generate a tool to predict the width of a string, so that I can avoid text overflow when printing reports in MS Access 2010. Options like CanGrow
are not useful, because my reports cannot have unpredicted page breaks. I cannot cut off text.
To this end I discovered the undocumented WizHook.TwipsFromFont
function in Access. It returns the width in twips of a string given font and other characteristics. It has proven quite useful as a starting point. Based on various user generated guides, I developed the following in Access:
Public Function TwipsFromFont(ByVal sCaption As String, ByVal sFontName As String, _
ByVal lSize As Long, Optional ByVal lWeight As Long = 400, _
Optional bItalic As Boolean = False, _
Optional bUnderline As Boolean = False, _
Optional lCch As Long = 0, _
Optional lMaxWidthCch As Long = 0) As Double
'inspired by http://www.team-moeller.de/?Tipps_und_Tricks:Wizhook-Objekt:TwipsFromFont
WizHook.Key = 51488399
Dim ldx As Long
Dim ldy As Long
Call WizHook.TwipsFromFont(sFontName, lSize, lWeight, bItalic, bUnderline, lCch, _
sCaption, lMaxWidthCch, ldx, ldy)
'Debug.Print CDbl(ldx)
TwipsFromFont = CDbl(ldx)
'TwipsFromFont = 99999
End Function
However, the data that will end up in Access is initially going to be generated in Excel 2010. Therefore, I would like to call this function in Excel, so I can check strings as they are created. To this end, I developed the following in Excel:
Public Function TwipsFromFontXLS() As Double
Dim obj As Object
Set obj = CreateObject("Access.Application")
With obj
.OpenCurrentDatabase "C:\MyPath\Jeremy.accdb"
TwipsFromFontXLS = .Run("TwipsFromFont", sCaption = "Hello World!", _
sFontName = "Arial Black", lSize = 20)
.Quit
End With
Set obj = Nothing
End Function
When I run debug.Print TwipsFromFont("Hello World!","Arial Black",20)
in Access I get back 2670. When I run debug.Print TwipsFromFontXLS()
in Excel I get back 585.
In Access, if I set TwipsFomFont = 9999
, then debug.Print TwipsFromFontXLS()
will return 9999
.
Any thoughts on where my disconnect is?
For those that are interested, the issue turned out to be how Application.Run
passed arguments. I was explicitly identifying my arguments, and this apparently created an issue. Below is code that appears to work when I call it in Excel. It isn't particularly fast, but at this point it works.
In Access:
Public Function TwipsFromFont(ByVal sCaption As String, ByVal sFontName As String, ByVal lSize As Long, Optional ByVal lWeight As Long = 400, Optional bItalic As Boolean = False, Optional bUnderline As Boolean = False, Optional lCch As Long = 0, Optional lMaxWidthCch As Long = 0) As Double
'inspired by http://www.team-moeller.de/?Tipps_und_Tricks:Wizhook-Objekt:TwipsFromFont
'required to call WizHook functions
WizHook.Key = 51488399
'width (ldx) and height (ldy) variables will be changed ByRef in the TwipsFromFont function
Dim ldx As Long
Dim ldy As Long
'call undocumented function
Call WizHook.TwipsFromFont(sFontName, lSize, lWeight, bItalic, bUnderline, lCch, sCaption, lMaxWidthCch, ldx, ldy)
'return printed text width in twips (1440 twips = 1 inch, 72 twips = 1 point, 20 points = 1 inch)
TwipsFromFont = CDbl(ldx)
End Function
In Excel:
Public Function TwipsFromFontXLS(ByVal sCaption As String, ByVal sFontName As String, ByVal lSize As Long, Optional ByVal lWeight As Long = 400, Optional bItalic As Boolean = False, Optional bUnderline As Boolean = False, Optional lCch As Long = 0, Optional lMaxWidthCch As Long = 0) As Double
'calls the WizHook.TwipsFromFont function from MS Access to calculate text width in twips
'create the application object
Dim obj As Object
Set obj = CreateObject("Access.Application")
With obj
'call the appropriate Access database
.OpenCurrentDatabase "C:\MyPath\Jeremy.accdb"
'pass the arguments to the Access function
'sCaption = the string to measure; sFontName = the Font; lSize = text size in points; lWeight = boldness, 400 is regular, 700 is bold, bItalic = italic style, bUnderline = underline style, lCch = number of characters with average width, lMaxwidth = number of characters with maximum width
TwipsFromFontXLS = .Run("TwipsFromFont", sCaption, sFontName, lSize, lWeight, bItalic, bUnderline, lCch, lMaxwidth)
'close the connection to the Access database
.Quit
End With
End Function
As remarked in Application.Run method:
You cannot use named arguments with this method. Arguments must be passed by position.
So simply remove sCaption, sFontName, and lSize and Excel call should return exact same as Access call, namely 2670. Explicitly defining all non-optional arguments is not needed.
Public Function TwipsFromFontXLS() As Double
Dim obj As Object
Set obj = CreateObject("Access.Application")
With obj
.OpenCurrentDatabase "C:\MyPath\Jeremy.accdb"
TwipsFromFontXLS = .Run("TwipsFromFont", "Hello World!", "Arial Black", 20)
.Quit
End With
Set obj = Nothing
End Function
In fact, had OP including Option Explicit
at top of module, these named arguments should have raised a runtime even compiled error as being undefined!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With