从Access子例程在Excel文档上运行VBA Excel脚本

时间:2016-04-25 12:11:54

标签: excel vba excel-vba ms-access access-vba

我有一段代码来查找右下角的单元格,它在excel中运行,我希望能够通过Access子程序运行它,它将返回单元格坐标(例如:J17)。但是我对Access并不熟悉,也不确定如何翻译代码。

Sub FindLast_Message()

MsgBox FindLast(3)

End Sub

Function FindLast(lRowColCell As Long, _
                Optional sSheet As String, _
                Optional sRange As String)
'Find the last row, column, or cell using the Range.Find method
'lRowColCell: 1=Row, 2=Col, 3=Cell

Dim lRow As Long
Dim lCol As Long
Dim wsFind As Worksheet
Dim rFind As Range

'Default to ActiveSheet if none specified
On Error GoTo ErrExit

If sSheet = "" Then
    Set wsFind = ActiveSheet
Else
    Set wsFind = Worksheets(sSheet)
End If

'Default to all cells if range no specified
If sRange = "" Then
    Set rFind = wsFind.Cells
Else
    Set rFind = wsFind.Range(sRange)
End If

On Error GoTo 0

Select Case lRowColCell

    Case 1 'Find last row
        On Error Resume Next
        FindLast = rFind.Find(What:="*", _
                        After:=rFind.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2 'Find last column
        On Error Resume Next
        FindLast = rFind.Find(What:="*", _
                        After:=rFind.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3 'Find last cell by finding last row & col
        On Error Resume Next
        lRow = rFind.Find(What:="*", _
                       After:=rFind.Cells(1), _
                       LookAt:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lCol = rFind.Find(What:="*", _
                        After:=rFind.Cells(1), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        FindLast = wsFind.Cells(lRow, lCol).Address(False, False)
        'If lRow or lCol = 0 then entire sheet is blank, return "A1"
        If Err.Number > 0 Then
            FindLast = rFind.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

End Select

Exit Function

ErrExit:

MsgBox "Error setting the worksheet or range."

End Function

以下是我需要与之协调的Access代码部分。 'J72'应该是前面代码返回的右下角单元格坐标。

Sub Format_Excel_Workbook(workbook_path As String, worksheet_name As String, myRows As Integer, myColumns As Integer)
'==============================================================================
Dim objExcelApp As Object
Dim xlWbk As Object
'==============================================================================

Dim x, y As String

x = "B2"
y = "J72"
Z = x & ":" & y

'==============================================================================
Set objExcelApp = New Excel.Application

objExcelApp.Workbooks.Open (workbook_path)

objExcelApp.Worksheets("t_DATA").Columns.AutoFit

objExcelApp.Worksheets("t_DATA").Range(x).Select

objExcelApp.ActiveWindow.FreezePanes = True

objExcelApp.Worksheets("t_DATA").Range(Z).HorizontalAlignment = xlCenter

objExcelApp.Worksheets("t_DATA").Range(Z).VerticalAlignment = xlTop

objExcelApp.ActiveWorkbook.Close (True)

Set objExcelApp = Nothing
'==============================================================================

End Sub

1 个答案:

答案 0 :(得分:0)

最简单的方法可能是将FindLast()函数的参数更改为对象而不是字符串:

Function FindLast(lRowColCell As Long, _
                  Optional sSheet As Excel.Worksheet, _
                  Optional sRange As Excel.Range)

从Excel中,您可以像这样调用此函数:

FindLast(3, , FindLast(3, , ThisWorkbook.Sheets(1).Range("A3:E7")))

在函数中,您必须更改使用参数sSheet和sRange的部分:只需使用提供的对象,而不是从字符串创建它们。

通过这种方式更改功能,您可以轻松地将其传输到其他主机应用程序(如Access),因为函数的调用者定义了函数应该在其上运行的对象,而不是函数本身。

从Access中你可以调用这样的函数:

FindLast(3, , objExcelApp.Worksheets("t_DATA").Range(Z))