accessからexcelマクロを実行する（インジケーターも表示）
Function exRunMcrObj()
'xls の マクロを実行
On Error GoTo Err_exRunMcrObj
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim sMDBName As String
With CreateObject("Scripting.FileSystemObject")
sMDBName = .GetFileName(CurrentDb.Name)
End With
Dim InPath As String
InPath = CurrentProject.Path
Dim InFile As String
InFile = "○○.xls"
Const mName = "○○" 'Excel マクロ名
Set xls = CreateObject("Excel.Application")
'Excel画面を非表示
xls.Visible = False
Dim i As Integer: i = 1 'インジケータ用カウンター
Dim varRet As Variant
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
'Access読込
Set cn = CurrentProject.Connection
With rst
.CursorLocation = 3 'adUseClient
.Open "SELECT ID FROM ○○ ORDER BY ID", cn
End With
Do Until rst.EOF Or rst.BOF
If i > 10 Then
Exit Do
End If
DoEvents
varRet = SysCmd(acSysCmdInitMeter, "処理中…" & i & "/" & rst.RecordCount, rst.RecordCount)
varRet = SysCmd(acSysCmdUpdateMeter, i)
'Excelを開く
Set wkb = xls.Workbooks.Open(InPath & "\" & InFile)
'マクロの実行
Call xls.Run(mName, rst![ID], sMDBName)
'処理終了後 Excel 終了
xls.Quit
Set wkb = Nothing
rst.MoveNext
i = i + 1
Loop
' 変数開放
rst.Close: cn.Close
Set rst = Nothing: Set cn = Nothing
exRunMcrObj = True
'処理終了
GoTo Exit_exRunMcrObj
Exit_exRunMcrObj:
'進行状況インジケータを消去します。
varRet = SysCmd(acSysCmdRemoveMeter)
'処理終了後 Excel 終了
xls.Quit
Set wkb = Nothing: Set xls = Nothing
If exRunMcrObj = True Then
MsgBox ("終わりました。")
End If
Exit Function
Err_exRunMcrObj:
MsgBox Err.Description
exRunMcrObj = False
Resume Exit_exRunMcrObj
End Function
-------ここからexcelマクロ処理----------------
Public Sub Run(Optional sId As String = "", Optional sMDBName As String = "")
ここはエクセル側の処理
End Sub
-------ここまでexcelマクロ処理----------------
マクロ実行
インジケーター
引数省略
ADO⇔DAO
