确定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

1/23/2018这里是对原始问题的更新

我找到了以下代码，它们完全按照我的需要执行，但是在关闭工作簿时，行上的宏错误指示：

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

好消息:只需要两个小改动就可以让它在我的系统上正常工作(Excel2013 x86 on Win 8.1 x64)：

• 注释掉冒犯的行(!)
• 为UnhookWinEvent添加以下声明(模块顶部为https://msdn.microsoft.com/en-us/library/windows/desktop/dd373671(v=vs.85%29.aspx)at)： 私有声明函数UnhookWinEvent Lib "user32.dll“(ByVal hHook As Long)

Set x=y将对象变量x设置为引用对象实例y。因此，它不能用于Long、String或其他非对象类型。这就是为什么在运行该行时会出现Object Required错误的原因。Set的详细信息在this question的答案中。

另外，我不知道代码是从哪里来的，但是如果StopEventHook函数工作正常，那么错误行将使它成为一个无操作函数：

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的comment“您可以通过在WinProc中不调用CallNextHookEx()来杀死钩子链”，这可能是问题的一部分。如果你遇到这个问题，却想不出解决办法，我建议你单独问一个问题。当然，也有很多人遇到过同样的事情！