我试图开发一个“自动运行”宏，以确定VBE是否已打开（不一定是焦点窗口，只要是打开的即可）。如果为真，则执行某些操作。
如果将此宏连接到CommandButton，则可以工作，但我无法在ThisWorkbook中的任何位置使其正常运行。
我被要求使用下面的函数执行同样的操作，但我也无法使其正常工作:
将以下内容复制粘贴到 ThisWorkbook 中:
如果将此宏连接到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
2018年1月23日，以下是对原问题的更新：
我找到了一段代码，正好符合我所需要的，但是在关闭工作簿时，宏报错并指出了错误的行：
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