从 Excel 调用的访问 vba 函数导致返回不同的值

Posted 2023-05-07

【中文标题】从 Excel 调用的访问 vba 函数导致返回不同的值

【英文标题】：Access vba function called from Excel results in different value returned

【发布时间】：2017-01-26 22:12:38

【问题描述】：

我的最终目标是生成一个预测字符串宽度的工具，这样我就可以在 MS Access 2010 中打印报告时避免文本溢出。CanGrow 之类的选项没有用，因为我的报告不能有不可预测的页面休息。我无法截断文字。

为此，我在 Access 中发现了未记录的 WizHook.TwipsFromFont 函数。它返回给定字体和其他特征的字符串的宽度（以缇为单位）。事实证明，它作为一个起点非常有用。根据各种用户生成的指南，我在 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 中调用此函数，以便在创建字符串时检查它们。为此，我在 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

当我在 Access 中运行 debug.Print TwipsFromFont("Hello World!","Arial Black",20) 时，我返回 2670。当我在 Excel 中运行 debug.Print TwipsFromFontXLS() 时，我返回 585。

在 Access 中，如果我设置了TwipsFomFont = 9999，那么debug.Print TwipsFromFontXLS() 将返回9999。

关于我的断开连接在哪里有什么想法吗？

【问题讨论】：

有趣的问题。不幸的是，我无法重现。 Access 和 Excel 都返回 2670。 Excel 宏放在哪里？在一张床单后面？这本工作簿？标准模块？

excel 宏位于标准模块“Module1”中，位于 xslm 工作簿的 VBAProject 部分。此工作簿中没有其他 VBA 函数。

我认为我有罪魁祸首：Application.Run 传递的参数与我在 VBA 中熟悉的略有不同。在我的设置中，它需要过程的名称，后跟所有必需的参数，按顺序排列，没有标识。例如，传递sCaption = "Hello World"! 是错误的，它应该只是"Hello World!"。这使得长期的可维护性更加困难，但我现在得到了我期望的返回值。

这很奇怪，因为您的确切代码都为我返回完全相同的返回：2670。现在检查一下以确定。而且您从不致电sCaption = "Hello World!"您使用的是什么版本的Access/Excel？和操作系统？

@Parfait：当您声明“而且您从不致电 sCaption = "Hello World!"。我在 Windows 7 上使用 MS Office 2010 时，我不确定您指的是哪里。

【参考方案1】：

对于那些感兴趣的人，问题原来是Application.Run 如何传递参数。我明确指出了我的论点，这显然造成了一个问题。下面是我在 Excel 中调用它时似乎可以工作的代码。它不是特别快，但在这一点上它可以工作。

访问中：

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

【参考方案2】：

如Application.Run方法中所述：

您不能在此方法中使用命名参数。参数必须是 按位置传递。

所以只需删除 sCaption、sFontName 和 lSize，Excel 调用应该返回与 Access 调用完全相同的结果，即 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，这些命名参数应该会引发运行时甚至编​​译错误为未定义！