我的现状:
我正在开发嵌入在 excel 文件(名为“Dashboard.xlsm”和 Access 文件“Dashboard.accdb”)中的 VBA 程序的顶点。这两个文件通过 VBA 相互通信,以帮助我对需要为我的公司进行分析的数据做一些繁重的工作。因为这些程序被分发给几个经理,他们在 3 秒内没有完成某些事情时会 panic ,所以我需要一种好方法来指示正在通过 Excel 在 Access 中运行的 SQL 查询的进度(因为 Access 在背景)。
我当前的 Excel 代码:
Sub generateFRMPComprehensive_ButtonClick(Optional sheetName As Variant)
Application.ScreenUpdating = False
Dim directoryPath As String
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL, strInput As String
Dim sArray As Variant
Dim appAccess As Access.Application
Dim directoryName
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
directoryName = Application.ActiveWorkbook.Path
directoryPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Dashboard Exports"
Application.ScreenUpdating = False
If IsMissing(sheetName) Then
sheetName = Application.InputBox("Sheet Name?", "Sheet Selection")
If sheetName = "False" Then
Exit Sub
Else
End If
If FileFolderExists(directoryPath) = 0 Then
Application.StatusBar = "Creating Export Folder"
MkDir directoryPath
End If
End If
'-- Set the workbook path and name
reportWorkbookName = "Report for " & sheetName & ".xlsx"
reportWorkbookPath = directoryPath & "\" & reportWorkbookName
'-- end set
'-- Check for a report already existing
If FileExists(reportWorkbookPath) = True Then
Beep
alertBox = MsgBox(reportWorkbookName & " already exists in " & directoryPath & ". Do you want to replace it?", vbYesNo, "File Exists")
If alertBox = vbYes Then
Kill reportWorkbookPath
'-- Run the sub again with the new sheetName, exit on completion.
generateFRMPComprehensive_ButtonClick (sheetName)
Exit Sub
ElseIf alertBox = vbNo Then
Exit Sub
ElseIf alertBox = "False" Then
Exit Sub
End If
End If
'-- End check
'- Generate the report
'-- Create new access object
Set appAccess = New Access.Application
'-- End Create
'-- Open the acces project
Application.StatusBar = "Updating Access DB"
Call appAccess.OpenCurrentDatabase(directoryName & "\Dashboard.accdb")
appAccess.Visible = False
'-- End open
'-- Import New FRMP Data
Application.StatusBar = "Running SQL Queries"
appAccess.Application.Run "CleanFRMPDB", sheetName, directoryName & "\Dashboard.xlsm"
'-- End Import
Workbooks.Add
ActiveWorkbook.SaveAs "Report for " & sheetName
ActiveWorkbook.Close
appAccess.Application.Run "generateFRMPReport_Access", reportWorkbookPath
Workbooks.Open (reportWorkbookPath)
End Sub
我当前的 Access 代码:
Public Sub generateFRMPReport_Access(excelReportFileLocation As String)
Dim queriesList As Variant
queriesList = Array("selectAppsWithNoHolds", _
"selectAppsWithPartialHolds", _
"selectAppsCompleted", _
"selectAppsCompletedEPHIY", _
"selectAppsByDivision", _
"selectAppsByGroup", _
"selectAppsEPHIY", _
"selectAppsEPHIN", _
"selectAppsEPHIYN", _
"selectApps")
For i = 0 To 9
DoCmd.TransferSpreadsheet acExport, , queriesList(i), _
excelReportFileLocation, True
Next i
End Sub
我的要求:
有没有一种方法可以从 Access 的“for”循环中调用 Application.DisplayStatusBar 并传递正在运行的查询的名称?
或者,我可以通过哪些其他方式显示此信息?
谢谢!!
最佳答案
您有几个选择可以实现这一点,但最明显的两个是:
- 从 Excel 执行查询,从 Excel 更新状态栏
- Access 执行查询,但将 Excel 应用程序引用传递给 Access,以便 Access 可以回调 Excel 状态栏。
由于您从 Excel 驱动事件,并且您已经引用了 Access 应用程序,因此第一个选项是最合乎逻辑的。第二种方法是可能的 - 您只需将 Excel 对象传递给 Access,然后您将使用 Excel 来自动化 Access 以自动化 Excel。
您需要将 generateFRMPReport_Access
过程从 Access VBA 移动到 Excel VBA,并修改对 generateFRMPComprehensive_ButtonClick
中过程的调用
Sub generateFRMPComprehensive_ButtonClick(Optional sheetName As Variant)
'...
'appAccess.Application.Run "generateFRMPReport_Access", reportWorkbookPath
generateFRMPReport_Access reportWorkbookPath, appAccess
'...
End Sub
Public Sub generateFRMPReport_Access(excelReportFileLocation As String, appAccess As Access.Application)
Dim queriesList As Variant
Dim i As Long
queriesList = Array("selectAppsWithNoHolds", _
"selectAppsWithPartialHolds", _
"selectAppsCompleted", _
"selectAppsCompletedEPHIY", _
"selectAppsByDivision", _
"selectAppsByGroup", _
"selectAppsEPHIY", _
"selectAppsEPHIN", _
"selectAppsEPHIYN", _
"selectApps")
Application.DisplayStatusBar = True
For i = 0 To 9
Application.StatusBar = "Running query " & (i + 1) & " of 9"
appAccess.DoCmd.TransferSpreadsheet acExport, , queriesList(i), _
excelReportFileLocation, True
Next i
Application.StatusBar = False
Application.DisplayStatusBar = False
End Sub
关于sql - 在 Access VBA 中更新 Excel Application.StatusBar,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/38312719/