[英]Using MS Access to run code in excel vba
我使用访问前端从 SQL Server 中提取查询。 然后我将记录集导出到一个新的 Excel 工作簿。 然后我想使用 excel 来运行我在 Access 中的代码。 它只是遍历单元格并添加格式并检查某个值。 我可以从访问中运行它,它将让工作簿打开循环。 然而,它是痛苦的缓慢。
如果我进入excel并粘贴访问正在运行的代码以进行格式化并检查。 它在几秒钟内运行。 但是从 access 运行它需要 10 多分钟。
如果可以做到这一点,有人有任何想法吗?
我已将此代码放在 Excel 的“ThisWorkbook”对象中:
Public Sub TestScript()
Debug.Print "Hello"
End Sub
然后使用表单上的按钮从 Access 成功调用它:
Private Sub cmdRunExcel_Click()
Dim xl As Excel.Application
Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Open "C:/Your/FolderPath/And/FileName.xlsx", True, False
xl.Run "ThisWorkbook.TestScript"
Set xl = Nothing
End Sub
不可否认,我没有给它很多代码来运行,但这里的代码至少在 Excel 上运行,从 Excel ......这肯定比尝试从 Access 在 Excel 上运行代码要好。
更新:看看您是否可以通过测试从 Access 到 Excel 创建模块(我无法正确测试它,因为我使用的是工作计算机,而且由于安全设置,它似乎不允许我运行此类代码)
Private Sub cmdRunExcel_Click()
Dim xl As Excel.Application
Dim myWrkBk As Excel.Workbook
Dim myModule As VBComponent
Dim strVb As String
Set xl = CreateObject("Excel.Application")
xl.Visible = True
xl.Workbooks.Open "C:/Your/FolderPath/And/FileName.xlsx", True, False
Set myWrkBk = xl.Workbooks.Add
Set myModule = myWrkBk.VBProject.VBComponents.Add(vbext_ct_StdModule)
strVb = "Public Sub TestScript()" & vbCrLf _
& "Debug.Print 'Hello'" _
& "End Sub"
myModule.CodeModule.AddFromString strVb
' xl.Run "ThisWorkbook.TestScript"
Set myModule = Nothing
Set myWrkBk = Nothing
Set xl = Nothing
End Sub
如果您希望在 Excel 中运行的代码始终相同,请打开一个 Excel 模板,其中包含一个宏工作簿,其中包含您的代码。 然后,从 Access 中,您可以运行一系列宏,当然,如果只将一个宏传递给参数数组,则只运行一个宏:
Function RunExcelMacros( _
ByVal strFileName As String, _
ParamArray avarMacros()) As Boolean
Debug.Print "xl ini", Time
On Error GoTo Err_RunExcelMacros
Static xlApp As Excel.Application
Dim xlWkb As Excel.Workbook
Dim varMacro As Variant
Dim booSuccess As Boolean
Dim booTerminate As Boolean
If Len(strFileName) = 0 Then
' Excel shall be closed.
booTerminate = True
End If
If xlApp Is Nothing Then
If booTerminate = False Then
Set xlApp = New Excel.Application
End If
ElseIf booTerminate = True Then
xlApp.Quit
Set xlApp = Nothing
End If
If booTerminate = False Then
Set xlWkb = xlApp.Workbooks.Open(FileName:=strFileName, UpdateLinks:=0, ReadOnly:=True)
' Make Excel visible (for troubleshooting only) or not.
xlApp.Visible = False 'True
For Each varMacro In avarMacros()
If Not Len(varMacro) = 0 Then
Debug.Print "xl run", Time, varMacro
booSuccess = xlApp.Run(varMacro)
End If
Next varMacro
Else
booSuccess = True
End If
RunExcelMacros = booSuccess
Exit_RunExcelMacros:
On Error Resume Next
If booTerminate = False Then
xlWkb.Close SaveChanges:=False
Set xlWkb = Nothing
End If
Debug.Print "xl end", Time
Exit Function
Err_RunExcelMacros:
Select Case Err
Case 0 'insert Errors you wish to ignore here
Resume Next
Case Else 'All other errors will trap
Beep
MsgBox "Error: " & Err & ". " & Err.Description, vbCritical +
vbOKOnly, "Error, macro " & varMacro
Resume Exit_RunExcelMacros
End Select
End Function
另外,请注意您 - 如上所示 - 必须非常严格地以正确的顺序打开、使用和关闭 Excel 对象。 没有 ActiveWorkbook 等。
基于 Matt Hall 的回答,但进行了更改以展示如何从 Access 中:
ThisWorkbook
之外的 Excel 模块; 在 Excel 中名为basTextModule
的自定义模块中:
Public Sub ShowCoolMessage()
MsgBox "cool"
End Sub
' Add02 is explictly ByRef (the default in VBA) to show that
' the parameter will be altered and have its value changed even for
' prodedures higher up the call stack.
Public Function GetCoolAmount(Add01 As Variant, _
Optional ByRef Add02 As Integer) As Integer
Add02 = Add02 + 1
GetCoolAmount = 10 + Add01 + Add02
End Function
在访问中:
对于通过引用传递的参数工作:
请注意Microsoft Docs 中的 Application.Run 方法 (Excel) ,当您将参数传递给 Excel Sub 或函数时,“您不能在此方法中使用命名参数。参数必须按位置传递”。
声明excelApp 时使用Object
而不是Excel.Application
以确保可以检索通过引用传递给 excelApp.Run 的任何参数的值。 资料来源:Jaafar Tribak“Application.Run ..(Argument Passed ByRef)”在https://www.mrexcel.com/board/threads/application-run-argument-passed-byref.998132/post-4790961
在被调用的 sub 或 Function 中,参数(除了第一个ModuleAndSubOrFunctionName
)必须具有与调用模块或函数的参数的数据类型匹配的数据类型。 它们可以是变体或特定的数据类型。 例如,出于说明目的, Arg02
是一个整数,因此在使用RunExcelCode(WorkbookPathAndFileName, "basTestModule.GetCoolAmount" ...)
时必须是GetCoolAmount
的第二个参数。
但是,为了使您的RunExcelCode
更通用,最好确保Arg01
、 Arg02
、 ... Arg30
参数都是变体; 因此,您最终调用的 sub 或 function 的参数也是变体,例如 ...
Public Function GetCoolAmount(Add01 As Variant, _ Optional ByRef Add02 As Variant) As Integer ...
Public Function RunExcelCode(WorkbookPathAndFileName As String, _
ModuleAndSubOrFunctionName As String, _
Optional ByRef Arg01 As Variant, _
Optional ByRef Arg02 As Integer) As Variant
' Must be Object, not Excel.Application, to allow for parameters pass by reference
Dim excelApp As Object
Dim workbook As Excel.workbook
Dim Result As Variant
On Error GoTo HandleErr
' Can be Excel.Application if excelApp previously declared as Object
Set excelApp = New Excel.Application
' excelApp.Visible = True ' For debugging
Set workbook = excelApp.Workbooks.Open(WorkbookPathAndFileName)
' Get a value from a function or,
' if it is a sub a zero length string "" will be returned
Result = excelApp.Run(ModuleAndSubOrFunctionName, Arg01, Arg02)
RunExcelCode = Result
ExitHere:
workbook.Close
excelApp.Quit
Set workbook = Nothing
Set excelApp = Nothing
Exit Function
HandleErr:
Select Case Err.number
Case Else
MsgBox "Error " & Err.number & ": " & Err.Description, _
vbCritical, "RunExcelCode"
End Select
Resume ExitHere
End Function
测试(来自 Access),调用一个 Sub 和一个函数:
Private Sub TestRunExcelCode()
Dim WorkbookPathAndFileName As String
Dim Result As Variant
WorkbookPathAndFileName = "C:\Users\YourName\Documents\MyWorkbook.xlsm"
' Run a sub
Result = RunExcelCode(WorkbookPathAndFileName, "basTestModule.ShowCoolMessage")
If IsNull(Result) Then
Debug.Print "{Null}"
ElseIf Result = "" Then
Debug.Print "{Zero length string}"
Else
Debug.Print Result
End If
' Will output "{Zero length string}"
' Get a value from a function
Dim Arg02 As Integer
Arg02 = 1
Debug.Print "Arg02 Before: " & Arg02
Result = RunExcelCode(WorkbookPathAndFileName, _
"basTestModule.GetCoolAmount", 1, Arg02)
Debug.Print "Arg02 After : " & Arg02 ' Value will have changed, as desired.
Debug.Print "Result : " & Result
End Sub
编辑 01:主要更改以使代码更通用。
编辑 02:处理通过引用传递的参数的重大更改。
编辑 03:在“使您的 RunExcelCode 更通用”的情况下添加了详细信息。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.