我的最终目标是生成一个工具来预测字符串的宽度,这样我就可以在 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。当我运行 debug.Print TwipsFromFontXLS()
在 Excel 中我得到 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
关于vba - 从 Excel 调用的 Access vba 函数会导致返回不同的值,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/41883924/