Question

我的最终目标是生成一个工具来预测字符串的宽度，以便在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。

有关我的断开连接的想法吗？

Answer 1

对于那些感兴趣的人来说，问题是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

Answer 2

正如Application.Run方法所述：

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

只需删除 sCaption ， sFontName 和 lSize ，Excel调用应与Access调用完全相同，即 2670 < / strong>即可。不需要明确定义所有非可选参数。

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在模块顶部，那么这些命名参数应该引发运行时甚至编译错误为未定义！

从Excel调用的Access vba函数会返回不同的值

2 个答案: