Accessing the vba function called from Excel returns a different value

My ultimate goal is to create a tool to predict line width so that I can avoid text overflow when printing reports in MS Access 2010. Parameters such as CanGrow are not useful because my reports cannot have an unexpected break page. I can not cut the text.

To this end, I discovered an undocumented WizHook.TwipsFromFont function in Access. It returns the width in twins of a string of a given font and other characteristics. This has proven very useful as a starting point. Based on various user-created 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 eventually end up in Access will initially be generated in Excel 2010. Therefore, I would like to call this function in Excel, so I can check the rows as they are created. To this end, in Excel, I developed the following:

 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 go back 2670. When I run debug.Print TwipsFromFontXLS() in Excel, I return 585.

In Access, if I set TwipsFomFont = 9999 , then debug.Print TwipsFromFontXLS() will return 9999 .

Any thoughts on where is my break?

+7
vba excel-vba ms-access excel
source share
2 answers

For those who are interested, the problem turned out to be how Application.Run passed the arguments. I clearly pointed out my arguments, and this apparently created a problem. Below is the code that works when I call it in Excel. This is not particularly fast, but at the moment it works.

Available:

 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 
+1
source share

As noted in Application.Run :

You cannot use named arguments with this method. Arguments must be passed position.

Thus, simply removing sCaption, sFontName and lSize and Excel should be returned just like an Access call, namely 2670 . Explicit definition of all optional arguments is not required.

 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, if the OP included Option Explicit at the top of the module, these named arguments should have led to an error even when compiling, as undefined!

0
source share

All Articles