从Excel中调用访问vba函数会返回不同的值
我的最终目标是生成一个预测string宽度的工具，以便在MS Access 2010中打印报表时避免文本溢出。像CanGrow这样的选项没有用处，因为我的报表不能有不可预知的分页符。 我不能切断文本。
为此，我在Access中发现了未WizHook.TwipsFromFont函数。 它返回给定字体和其他特征的string的缇宽度。 事实certificate，这是一个非常有用的起点。 基于各种用户生成的指南，我在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
但是，最终将在Access中生成的数据最初将在Excel 2010中生成。因此，我想在Excel中调用此函数，以便在创buildstring时检查它们。 为此，我在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
当我在debug.Print TwipsFromFont("Hello World!","Arial Black",20)运行debug.Print TwipsFromFont("Hello World!","Arial Black",20) ，我得到了2670.当我在Excel中运行debug.Print TwipsFromFontXLS() ，返回585。
在Access中，如果我设置TwipsFomFont = 9999 ，那么debug.Print TwipsFromFontXLS()将返回9999 。
任何想法，我的断开连接是什么？
对于那些感兴趣的，问题原来是如何Application.Run传递参数。 我明确地表明了我的论点，这显然造成了一个问题。 下面是我在Excel中调用它时出现的代码。 这不是特别快，但在这一点上，它的工作。
在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
在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
正如Application.Run方法中所述：
这个方法不能使用命名参数。 参数必须按位置传递。
所以简单地删除sCaption ， sFontName ， lSize和Excel调用应该返回完全相同的访问调用，即2670 。 显式定义所有非可选参数是不需要的。
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
实际上，如果OP在模块的顶部包含Option Explicit ，那么这些命名参数应该会引发一个运行时错误，因为这个错误是未定义的！