确定 VBE 是否打开
Determine if the VBE is open
我正在尝试开发一个'auto run'宏来确定VBE是否打开(不一定是焦点的window,只是打开)。如果这是真的,那么...采取一些行动。
如果此宏连接到命令按钮,它可以工作,但我无法让它在 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
好消息:只需要两个小改动就可以让它在我的系统上正常工作(Excel 2013 x86 on 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
的详细信息在 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 有时会崩溃,但并非总是如此。实际上,我不认为这是个问题,因为我习惯于使用 hooks 来降低 Office :) 。但是,@RossBush 的 "you could be killing the hook chain by not calling CallNextHookEx() in your WinProc" 可能是问题的一部分。如果您 运行 遇到了那个问题并且不知道如何解决它,我建议您提出一个单独的问题。肯定有很多人遇到过同样的情况!
为什么不将 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
我正在尝试开发一个'auto run'宏来确定VBE是否打开(不一定是焦点的window,只是打开)。如果这是真的,那么...采取一些行动。
如果此宏连接到命令按钮,它可以工作,但我无法让它在 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
好消息:只需要两个小改动就可以让它在我的系统上正常工作(Excel 2013 x86 on 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
的详细信息在 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 有时会崩溃,但并非总是如此。实际上,我不认为这是个问题,因为我习惯于使用 hooks 来降低 Office :) 。但是,@RossBush 的
为什么不将 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