Access vba function called from Excel results in different value returned

Question

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?

Jarvis

Interesting question. Unfortunately, I cannot reproduce. Both Access and Excel return 2670. Where is Excel macro placed? Behind a Sheet? ThisWorkbook? Standard module? – Penmanship

The excel macro is in a standard module, 'Module1', in the VBAProject section of an xslm Workbook. There are no other VBA functions in this workbook. – Jarvis

I think I have the culprit: Application.Run passes arguments slightly differently than what I am familiar with in VBA. In my setup it is expecting the name of the procedure, followed by all required arguments, in order, and without identification. For example, passing sCaption = "Hello World"! is wrong, it should just be "Hello World!". This makes the long run maintainability a little tougher, but I am now getting the returned values I am expecting. – Jarvis

That is strange as your exact code in both return for me exact same return: 2670. Just checked now to be sure. And you never call sCaption = "Hello World!" What version of Access/Excel are you using? And OS? – Penmanship

@Parfait: I'm not certain where you are referring when you state "And you never call sCaption = "Hello World!". I am using MS Office 2010 on Windows 7. – Jarvis

Answer 1

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

Jarvis

Thanks. I tried it out using this function. But I got a negative value result, if the input-string exceeds a number of greater that 32767. I tried to figure out, why this could be, but didn't find the reason. ?TwipsFromFont("asdfasdasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfasdfs asdfasdfasdfasdfasd asdfasdf asdfsad fasdf asdf sadf sadf asdf asdfääsadf aäääääää ä1", "Tahoma", 20) -32521 – Idiomatic

Answer 2

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!

Penmanship