Определите, открыт ли VBE

Question

Я пытаюсь разработать макрос "автозапуск", чтобы определить, открыт ли VBE (не обязательно окно фокуса, просто открыть). Если это ИСТИНА, тогда... предпримите некоторые действия.

Если этот макрос подключен к CommandButton, он работает, но я не могу заставить его работать где-либо в ThisWorkbook:

Sub CloseVBE()
    'use the MainWindow Property which represents
    ' the main window of the Visual Basic Editor - open the code window in VBE,
    ' but not the Project Explorer if it was closed previously:
    If Application.VBE.MainWindow.Visible = True Then
        MsgBox ""
        'close VBE window:
        Application.VBE.MainWindow.Visible = False
    End If

End Sub

Мне дали следующую ФУНКЦИЮ, чтобы сделать то же самое, но я также не могу заставить ее работать:

Option Explicit

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Const GW_HWNDNEXT = 2

Function VBE_IsOpen() As Boolean

    Const appName       As String = "Visual Basic for Applications"

    Dim stringBuffer    As String
    Dim temphandle      As Long

    VBE_IsOpen = False

    temphandle = FindWindow(vbNullString, vbNullString)
    Do While temphandle <> 0
        stringBuffer = String(GetWindowTextLength(temphandle) + 1, Chr$(0))
        GetWindowText temphandle, stringBuffer, Len(stringBuffer)
        stringBuffer = Left$(stringBuffer, Len(stringBuffer) - 1)
        If InStr(1, stringBuffer, appName) > 0 Then
            VBE_IsOpen = True
            CloseVBE
        End If
        temphandle = GetWindow(temphandle, GW_HWNDNEXT)
    Loop

End Function

23.01.2008 Вот обновление к оригинальному вопросу:

Я нашел следующий код, который выполняет ТОЧНО так, как мне было нужно, но при закрытии книги ошибки макроса в указанной строке:

Public Sub StopEventHook(lHook As Long)
    Dim LRet As Long
    Set lHook = 0'<<<------ When closing workbook, errors out on this line.
    If lHook = 0 Then Exit Sub
    LRet = UnhookWinEvent(lHook)    

    Exit Sub
End Sub

Вот весь код, вставьте его в обычный модуль:

Option Explicit

Private Const EVENT_SYSTEM_FOREGROUND = &H3&
Private Const WINEVENT_OUTOFCONTEXT = 0

Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, _
    ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, _
    ByVal idThread As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long

Private pRunningHandles As Collection

Public Function StartEventHook() As Long
  If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
  StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
  pRunningHandles.Add StartEventHook
End Function

Public Sub StopEventHook(lHook As Long)
  Dim LRet As Long
  On Error Resume Next
  Set lHook = 0  '<<<------ When closing workbook, errors out on this line.
    If lHook = 0 Then Exit Sub
    LRet = UnhookWinEvent(lHook)    

    Exit Sub
End Sub

Public Sub StartHook()
    StartEventHook
End Sub

Public Sub StopAllEventHooks()
  Dim vHook As Variant, lHook As Long
  For Each vHook In pRunningHandles
    lHook = vHook
    StopEventHook lHook
  Next vHook
End Sub

Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, _
                            ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, _
                            ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
  'This function is a callback passed to the win32 api
  'We CANNOT throw an error or break. Bad things will happen.
  On Error Resume Next
  Dim thePID As Long

  If LEvent = EVENT_SYSTEM_FOREGROUND Then
    GetWindowThreadProcessId hWnd, thePID
    If thePID = GetCurrentProcessId Then
      Application.OnTime Now, "Event_GotFocus"
    Else
      Application.OnTime Now, "Event_LostFocus"
    End If
  End If

  On Error GoTo 0
End Function

Public Sub Event_GotFocus()
    Sheet1.[A1] = "Got Focus"
End Sub

Public Sub Event_LostFocus()
    Sheet1.[A1] = "Nope"
End Sub

Вставьте это в ThisWorkbook:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopAllEventHooks
End Sub

Private Sub Workbook_Open()
    StartHook
End Sub

Answer 1

Почему бы просто не использовать модуль ThisWorkBook с Workbook_Open событие?

Код в ThisWorkBook модуль кода

 Private Sub Workbook_Open()         ' or...  Sub Workbook_Activate()
   ' checkIsVBEOpen
   If Application.VBE.MainWindow.Visible = True Then
      MsgBox "VBE window is open", vbInformation
      ' do something
      ' ...
      ' close VBE window
        Application.VBE.MainWindow.Visible = False
    Else
      MsgBox "VBE window is NOT open"   ' do nothing else
   End If
End Sub

Answer 2

Хорошая новость: для корректной работы в моей системе требуется всего два небольших изменения (Excel 2013 x86 на Win 8.1 x64):

• Закомментируйте оскорбительную строку (!)

• Добавьте следующую декларацию для UnhookWinEventв верхней части модуля:

  Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hHook As Long)
  

Set x=yустанавливает переменнуюобъекта xссылаться на экземпляр объектаy, В результате он не может быть использован для Long, Stringили другие необъектные типы. Вот почему вы получаете Object Requiredошибка при запуске этой строки. Детали Setнаходятся в ответах на этот вопрос.

Отдельно я не уверен, откуда вы взяли код, но строка с ошибкойStopEventHookФункция no-op, если это сработало:

Public Sub StopEventHook(lHook As Long)
    Dim LRet As Long
    On Error Resume Next
    Set lHook = 0  '<<<- The error line --- throws away the input parameter!
    If lHook = 0 Then Exit Sub    ' ... then this always causes the Sub to exit.
    LRet = UnhookWinEvent(lHook)    

    Exit Sub ' note: don't need this; you can remove it if you want.
End Sub

ЕслиlHookдействительно был установлен в 0, следующая строка всегда будет вызыватьSubчтобы выйти, так что крюк никогда не будет выгружен.

Возможная проблема с аварией

Иногда Excel закрывается, когда я закрываю книгу, но не всегда. Я на самом деле не думаю об этом как о проблеме, потому что я привык к хукам, обрушивающим Office:) . Однако комментарий@RossBush о том, что "вы можете убить цепочку хуков, не вызывая CallNextHookEx() в WinProc", может быть частью проблемы. Если вы столкнулись с этой проблемой и не можете понять, как ее исправить, я бы предложил задать отдельный вопрос. Конечно, есть много людей, которые сталкивались с тем же!