Функция доступа vba, вызванная из Excel, возвращает другое значение

моя конечная цель-создать инструмент для прогнозирования ширины строки, чтобы я мог избежать переполнения текста при печати отчетов в MS Access 2010. Варианты типа CanGrow не полезны, потому что мои отчеты не могут иметь незапланированные разрывы страниц. Я не могу отрезать текст.

С этой целью я обнаружил недокументированные в Access. Он возвращает ширину в поворотах строки заданного шрифта и других характеристик. Она оказалась весьма полезной в качестве отправной точки. Основываясь на различных пользовательских руководствах, я разработал следующее В 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:MyPathJeremy.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) в Access я возвращаюсь 2670. Когда я бегу debug.Print TwipsFromFontXLS() в Excel я возвращаюсь 585.

In Доступ, если я установил TwipsFomFont = 9999, потом debug.Print TwipsFromFontXLS() вернутся 9999.

мысли о том, где мое отключение?

7
excel excel-vba ms-access vba

2 ответов

для тех, кто заинтересован, вопрос оказался как 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
1

Как заметил приложение.Запустить способ:

вы не можете использовать именованные аргументы с помощью этого метода. Аргументы должны быть прошел мимо позиции.

так просто удалить 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

In факт, имел OP в том числе Option Explicit в верхней части модуля эти именованные аргументы должны были вызвать даже скомпилированную ошибку среды выполнения как неопределенную!

0