Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Access vba function called from Excel results in different value returned

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?

like image 465
Jeremy Avatar asked Jan 26 '17 22:01

Jeremy


2 Answers

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
like image 174
Jeremy Avatar answered Oct 22 '22 08:10

Jeremy


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!

like image 35
Parfait Avatar answered Oct 22 '22 07:10

Parfait