Отслеживание деактивации приложения Excel, подскажите как реализовать в VBA

[Pnebroev]

Уважаемые, облазил весь инет. Подскажите, как отследить деактивацию приложения excel через vba? Нужно совершать определённое действие, когда приложение не активно! Очень буду признателен.

[pashulka]

Такого события, как деактивация приложения(в отличии от листа, книги) не существует, но можно попробовать использовать таймер, например :

Код: Выделить всё

Public Declare Function GetActiveWindow Lib "user32.dll" () As Long

Public Sub Auto_Open()
    getActiveWnd
End Sub

Public Sub getActiveWnd() 'Excel XP(и старше)
    If Application.Hwnd <> GetActiveWindow Then
       Application.Caption = "Пора начать работать со мной"
    Else
       Application.Caption = ""
    End If
    Application.OnTime DateAdd("s", 1, Now), "getActiveWnd"
End Sub

Вышеопубликованный код имеет смысл расположить в стандартном модуле личной книги макросов "Personal.xls"

[Pnebroev]

Ох, спасибо! А то всю голову сломал...

[Pnebroev]

Такого события, как деактивация приложения(в отличии от листа, книги) не существует, но можно попробовать использовать таймер, например :

Код: Выделить всё

Public Declare Function GetActiveWindow Lib "user32.dll" () As Long

Public Sub Auto_Open()
    getActiveWnd
End Sub

Public Sub getActiveWnd() 'Excel XP(и старше)
    If Application.Hwnd <> GetActiveWindow Then
       Application.Caption = "Пора начать работать со мной"
    Else
       Application.Caption = ""
    End If
    Application.OnTime DateAdd("s", 1, Now), "getActiveWnd"
End Sub

Вышеопубликованный код имеет смысл расположить в стандартном модуле личной книги макросов "Personal.xls"

Возник вопрос, куда и как это вставить чтобы работало при открытой форме?

[pashulka]

Никуда, ибо данный пример не предназначен для таких задач, впрочем, Вы можете попробовать получить ClassName (WinAPI функция GetClassName) активного окна и сравнивать его с заданным перечнем.

Код: Выделить всё

Public Declare Function GetActiveWindow _
       Lib "user32.dll" () As Long
Public Declare Function GetClassName _
       Lib "user32.dll" Alias "GetClassNameA" ( _
       ByVal hWnd As Long, _
       ByVal lpClassName As String, _
       ByVal nMaxCount As Long) As Long

Public Sub Auto_Open()
    getActiveWnd
End Sub

Public Sub getActiveWnd() 'Excel XP(и старше)
    Dim iClassName$, iLength&
    
    iClassName = Space(255)
    iLength = GetClassName(GetActiveWindow, iClassName, 255&)

    Select Case UCase(Left(iClassName, iLength))
        Case "XLMAIN", "THUNDERDFRAME" 'И ТАК ДАЛЕЕ
           Application.Caption = ""
        Case Else
           Application.Caption = "Пора начать работать со мной"
    End Select
    Application.OnTime DateAdd("s", 1, Now), "getActiveWnd"
End Sub

[pashulka]

Вот ещё один вариант, который будет работать и при наличии UserForm

Код: Выделить всё

Public Declare Function GetActiveWindow _
       Lib "user32.dll" () As Long
Public Declare Function IsWindowVisible _
       Lib "user32.dll" (ByVal hWnd As Long) As Long
       
Public Sub Auto_Open()
    getActiveWnd
End Sub

Public Sub getActiveWnd() 'Excel 97(и старше)
    If IsWindowVisible(GetActiveWindow) = 1 Then
       Application.Caption = ""
    Else
       Application.Caption = "Пора начать работать со мной"
    End If
    Application.OnTime DateAdd("s", 1, Now), "getActiveWnd"
End Sub