Exit Sub

OLE_Error:

Select Case Err

Case 429

blnIsAppOpen = False

Resume OLE_continue

Case Else

MsgBox Prompt:="Неизвестная ошибка", _

Buttons:=vbInformation

End Select

End Sub

Приведенную выше процедуру можно запустить как макрос (например, из Word).

Этот прием можно использовать для Word, Access и PowerPoint. Но в Excel этот вариант не проходит: Excel открывает еще один объект-приложение вне зависимости, существовал ли он уже.

Более подробную информацию об описанных функциях можно получить в справочной системе.

Пример вычислений в Access с помощью Excel

Ниже приведен код процедуры, производящий вычисления с помощью Excel для данных, хранящихся в базе данных Access. Эта процедура запускается из Access, она содержится в базе данных OLE.MDB, в программном модуле. В процедуре осуществляется вычисление переменной амортизации для имущества, записанного в первой записи таблицы «Имущество» (Assets) базы данных OLE.MDB. Automation используется для создания рабочего листа Excel и применения для вычисления встроенной функции Excel VDB (функции ПДОБ, которая возвращает значение амортизации имущества за данный период, включая конкретные периоды, используя метод двойного процента со снижающегося остатка или иной явно указанный метод).

Sub ComputeVDB()

On Error GoTo ComputeVDBError

Dim intXLFlag As Integer

Dim objXLSheet As Object

Dim dbSolution As Database

Dim rstAsset As Recordset

Dim intNumFields As Integer

Dim intCount As Integer

Dim intOpen As Integer

Dim strMsg As String

Set dbSolution = DBEngine(0)(0)

Set rstAsset = dbSolution.OpenRecordset("Assets")

intOpen = IsAppOpen("XLMAIN")

If intOpen = -1 Then

‘ Вызов функции Win32 API для регистрации Excel

‘ в OLE RunningObjectTable (это необходимо,

‘ если вы хотите использовать текущий запущенный

‘ экземпляр Excel, и не нанести ущерба):

RegisterExcel hwndExcel, WM_USER + 18, 0, 0

‘ Получаем ссылку на открытый экземпляр Excel:

Set objXLSheet = GetObject(, "Excel.Application")

ElseIf intOpen = 1 Then

‘ Создаем новый экземпляр Excel:

Set objXLSheet = CreateObject("Excel.Application")

‘ и устанавливаем флаг, чтобы закрыть Excel в конце:

intXLFlag = 1

Else

strMsg = "Произошла ошибка в ComputeVDB. "

strMsg = strMsg & "Код ошибки = " & Err

MsgBox strMsg, vbExclamation, APP_NAME