2016-04-25 87 views
0

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

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 

下面是访问代码,我需要协调这一部分。 '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 

回答

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的那些部分:只需使用提供的对象,而不是从钢带中创建它们GS。

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

从访问你可以调用这样的功能:

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