使用 VBA 清除即时窗口？

Question

有人知道如何使用 VBA 清除即时窗口吗？

虽然我总是可以自己手动清除它，但我很好奇是否有办法以编程方式执行此操作。

Answer 1

要做到我所设想的要困难得多。我通过 keepitcool 找到了一个版本 here，它避免了可怕的 Sendkeys

从常规模块运行它。

更新为初始帖子错过了私有函数声明 - 你的复制和粘贴工作真的很糟糕

Private Declare Function GetWindow _
Lib "user32" ( _
ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx _
Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function GetKeyboardState _
Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function SetKeyboardState _
Lib "user32" (lppbKeyState As Byte) As Long
Private Declare Function PostMessage _
Lib "user32" Alias "PostMessageA" ( _
ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long _
) As Long


Private Const WM_KEYDOWN As Long = &H100
Private Const KEYSTATE_KEYDOWN As Long = &H80


Private savState(0 To 255) As Byte


Sub ClearImmediateWindow()
'Adapted  by   keepITcool
'Original from Jamie Collins fka "OneDayWhen"
'http://www.dicks-blog.com/excel/2004/06/clear_the_immed.html


Dim hPane As Long
Dim tmpState(0 To 255) As Byte


hPane = GetImmHandle
If hPane = 0 Then MsgBox "Immediate Window not found."
If hPane < 1 Then Exit Sub


'Save the keyboardstate
GetKeyboardState savState(0)


'Sink the CTRL (note we work with the empty tmpState)
tmpState(vbKeyControl) = KEYSTATE_KEYDOWN
SetKeyboardState tmpState(0)
'Send CTRL+End
PostMessage hPane, WM_KEYDOWN, vbKeyEnd, 0&
'Sink the SHIFT
tmpState(vbKeyShift) = KEYSTATE_KEYDOWN
SetKeyboardState tmpState(0)
'Send CTRLSHIFT+Home and CTRLSHIFT+BackSpace
PostMessage hPane, WM_KEYDOWN, vbKeyHome, 0&
PostMessage hPane, WM_KEYDOWN, vbKeyBack, 0&


'Schedule cleanup code to run
Application.OnTime Now + TimeSerial(0, 0, 0), "DoCleanUp"


End Sub


Sub DoCleanUp()
' Restore keyboard state
SetKeyboardState savState(0)
End Sub


Function GetImmHandle() As Long
'This function finds the Immediate Pane and returns a handle.
'Docked or MDI, Desked or Floating, Visible or Hidden


Dim oWnd As Object, bDock As Boolean, bShow As Boolean
Dim sMain$, sDock$, sPane$
Dim lMain&, lDock&, lPane&


On Error Resume Next
sMain = Application.VBE.MainWindow.Caption
If Err <> 0 Then
MsgBox "No Access to Visual Basic Project"
GetImmHandle = -1
Exit Function
' Excel2003: Registry Editor (Regedit.exe)
'    HKLM\SOFTWARE\Microsoft\Office\11.0\Excel\Security
'    Change or add a DWORD called 'AccessVBOM', set to 1
' Excel2002: Tools/Macro/Security
'    Tab 'Trusted Sources', Check 'Trust access..'
End If


For Each oWnd In Application.VBE.Windows
If oWnd.Type = 5 Then
bShow = oWnd.Visible
sPane = oWnd.Caption
If Not oWnd.LinkedWindowFrame Is Nothing Then
bDock = True
sDock = oWnd.LinkedWindowFrame.Caption
End If
Exit For
End If
Next
lMain = FindWindow("wndclass_desked_gsk", sMain)
If bDock Then
'Docked within the VBE
lPane = FindWindowEx(lMain, 0&, "VbaWindow", sPane)
If lPane = 0 Then
'Floating Pane.. which MAY have it's own frame
lDock = FindWindow("VbFloatingPalette", vbNullString)
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
While lDock > 0 And lPane = 0
lDock = GetWindow(lDock, 2) 'GW_HWNDNEXT = 2
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
Wend
End If
ElseIf bShow Then
lDock = FindWindowEx(lMain, 0&, "MDIClient", _
vbNullString)
lDock = FindWindowEx(lDock, 0&, "DockingView", _
vbNullString)
lPane = FindWindowEx(lDock, 0&, "VbaWindow", sPane)
Else
lPane = FindWindowEx(lMain, 0&, "VbaWindow", sPane)
End If


GetImmHandle = lPane


End Function

Answer 2

以下是here的解决方案

Sub stance()
Dim x As Long

For x = 1 To 10    
    Debug.Print x
Next

Debug.Print Now
Application.SendKeys "^g ^a {DEL}"    
End Sub

Answer 3

SendKeys 是直接的，但您可能不喜欢它（例如，如果关闭，它会打开立即窗口，并移动焦点）。

WinAPI + VBE 的方式非常精细，但您可能不希望授予 VBA 对 VBE 的访问权限（甚至可能是您的公司集团政策不允许）。

您可以用空白将其内容 （或其中的一部分...） 刷新，而不是清除：

Debug.Print String(65535, vbCr)

不幸的是，这仅在插入符号位置位于即时窗口末尾时才有效（插入字符串，未附加）。如果您只通过 Debug.Print 发布内容并且不以交互方式使用该窗口，这将完成这项工作。如果您积极使用窗口并偶尔导航到内容中，这并没有多大帮助。

Answer 4

经过一些实验，我对mehow的代码做了一些修改，如下：

1. 陷阱错误（原始代码由于未设置对“VBE”的引用而失败，为了清楚起见，我也将其更改为 myVBE）
2. 将“立即”窗口设置为可见（以防万一！）
3. 注释掉了将焦点返回到原始窗口的行，因为正是这一行导致代码窗口内容在发生计时问题的机器上被删除（我在 Win 7 x64 上使用 PowerPoint 2013 x32 验证了这一点）。似乎焦点在 SendKeys 完成之前切换回来，即使 Wait 设置为 True！
4. 更改 SendKeys 上的等待状态，因为我的测试环境似乎没有遵守它。

我还注意到该项目必须信任已启用的 VBA 项目对象模型。

' DEPENDENCIES
' 1. Add reference:
' Tools > References > Microsoft Visual Basic for Applications Extensibility 5.3
' 2. Enable VBA project access:
' Backstage / Options / Trust Centre / Trust Center Settings / Trust access to the VBA project object model

Public Function ClearImmediateWindow()
  On Error GoTo ErrorHandler
  Dim myVBE As VBE
  Dim winImm As VBIDE.Window
  Dim winActive As VBIDE.Window

  Set myVBE = Application.VBE
  Set winActive = myVBE.ActiveWindow
  Set winImm = myVBE.Windows("Immediate")

  ' Make sure the Immediate window is visible
  winImm.Visible = True

  ' Switch the focus to the Immediate window
  winImm.SetFocus

  ' Send the key sequence to select the window contents and delete it:
  ' Ctrl+Home to move cursor to the top then Ctrl+Shift+End to move while
  ' selecting to the end then Delete
  SendKeys "^{Home}", False
  SendKeys "^+{End}", False
  SendKeys "{Del}", False

  ' Return the focus to the user's original window
  ' (comment out next line if your code disappears instead!)
  'winActive.SetFocus

  ' Release object variables memory
  Set myVBE = Nothing
  Set winImm = Nothing
  Set winActive = Nothing

  ' Avoid the error handler and exit this procedure
  Exit Function

ErrorHandler:
   MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & Err.Description, _
      vbCritical + vbOKOnly, "There was an unexpected error."
  Resume Next
End Function

Answer 5

甚至更简单

Sub clearDebugConsole()
    For i = 0 To 100
        Debug.Print ""
    Next i
End Sub

Answer 6

这是一个想法的组合（用 excel vba 2007 测试）：

' *（这可以代替您日常调试的电话）

Public Sub MyDebug(sPrintStr As String, Optional bClear As Boolean = False)
   If bClear = True Then
      Application.SendKeys "^g^{END}", True

      DoEvents '  !!! DoEvents is VERY IMPORTANT here !!!

      Debug.Print String(30, vbCrLf)
   End If

   Debug.Print sPrintStr
End Sub

不喜欢删除即时内容（怕误删代码， 所以上面是对你们都写的一些代码的破解。

这解决了 Akos Groller 上面所写的问题： “很遗憾，这仅在插入符号位置位于末尾时才有效 立即窗口"

代码打开立即窗口（或将焦点放在它上面）， 发送一个 CTRL+END，然后是一大堆换行符， 所以之前的调试内容看不到了。

请注意，DoEvents 至关重要，否则逻辑会失败 （插入符号位置不会及时移动到立即窗口的末尾）。

Answer 7

Sub ClearImmediateWindow()
    SendKeys "^{g}", False
    DoEvents
    SendKeys "^{Home}", False
      SendKeys "^+{End}", False
      SendKeys "{Del}", False
        SendKeys "{F7}", False
End Sub

Answer 8

我遇到了同样的问题。以下是我在 Microsoft 链接的帮助下解决问题的方法：https://msdn.microsoft.com/en-us/library/office/gg278655.aspx

Sub clearOutputWindow()
  Application.SendKeys "^g ^a"
  Application.SendKeys "^g ^x"
End Sub

Answer 9

我赞成永远不要依赖快捷键，因为它可能适用于某些语言，但不是全部... 这是我的微薄贡献：

Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
    Debug.Print VBA.String(200, vbNewLine)
End Sub

Answer 10

为了清理 立即 窗口，我使用 (VBA Excel 2016) 下一个功能：

Private Sub ClrImmediate()
   With Application.VBE.Windows("Immediate")
       .SetFocus
       Application.SendKeys "^g", True
       Application.SendKeys "^a", True
       Application.SendKeys "{DEL}", True
   End With
End Sub

但是像这样直接调用ClrImmediate()：

Sub ShowCommandBarNames()
    ClrImmediate
 '--   DoEvents    
    Debug.Print "next..."
End Sub

只有在我将断点放在Debug.Print 上时才有效，否则将在执行ShowCommandBarNames() 之后完成清除 - 而不是在 Debug.Print 之前。 不幸的是，DoEvents() 的调用对我没有帮助......而且无论：TRUE 或 FALSE 设置为 SendKeys。

为了解决这个问题，我使用了接下来的几个调用：

Sub ShowCommandBarNames()
 '--    ClrImmediate
    Debug.Print "next..."
End Sub

Sub start_ShowCommandBarNames()
   ClrImmediate
   Application.OnTime Now + TimeSerial(0, 0, 1), "ShowCommandBarNames"
End Sub

在我看来，使用 Application.OnTime 在 VBA IDE 编程中可能非常有用。在这种情况下，它甚至可以使用 TimeSerial(0, 0, 0)。

Answer 11

如果通过工作表中的按钮触发，标记的答案将不起作用。它打开转到 excel 对话框，因为 CTRL+G 是快捷方式。您必须先在即时窗口上设置焦点。如果您想在清除后立即Debug.Print，您可能还需要DoEvent。

Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^g ^a {DEL}"
DoEvents

为了完整性，正如@Austin D 注意到的那样：

对于那些想知道的人，快捷键是 Ctrl+G（激活 立即窗口），然后 Ctrl+A（选择所有内容），然后 Del（选择 清除它）。

Answer 12

我根据上面所有的 cmets 测试了这段代码。似乎完美无缺。评论？

Sub ResetImmediate()  
        Debug.Print String(5, "*") & " Hi there mom. " & String(5, "*") & vbTab & "Smile"  
        Application.VBE.Windows("Immediate").SetFocus  
        Application.SendKeys "^g ^a {DEL} {HOME}"  
        DoEvents  
        Debug.Print "Bye Mom!"  
End Sub

之前使用了Debug.Print String(200, chr(10))，它利用了 200 行的缓冲区溢出限制。不太喜欢这种方法，但它确实有效。

Answer 13

刚刚签入 Excel 2016，这段代码对我有用：

Sub ImmediateClear()
   Application.VBE.Windows("Immediate").SetFocus
   Application.SendKeys "^{END} ^+{HOME}{DEL}"
End Sub

Answer 14

如果你碰巧使用 Autohotkey，这是我使用的脚本。

关键命令是Ctrl+Delete。它仅在 VBE 处于活动状态时才有效。
按下它会清除即时窗口，然后通过F7 激活代码编辑器。

我倾向于在编码时清除即时信息，所以现在我可以点击Ctrl-Delete 并继续编码。 ?

#IfWinActive, ahk_class wndclass_desked_gsk

^Delete:: clearImmediateWindow()

#If

clearImmediateWindow() {
    Send, ^g
    Send, ^a
    Send, {Delete}
    Send, {F7}
}

Answer 15

• 没有发送密钥？
• 没有 VBA 可扩展性？
• 没有第 3 方可执行文件？
• 没问题！

Windows API 解决方案

Option Explicit

Private Declare PtrSafe _
            Function FindWindowA Lib "user32" ( _
                            ByVal lpClassName As String, _
                            ByVal lpWindowName As String _
                            ) As LongPtr
Private Declare PtrSafe _
            Function FindWindowExA Lib "user32" ( _
                            ByVal hWnd1 As LongPtr, _
                            ByVal hWnd2 As LongPtr, _
                            ByVal lpsz1 As String, _
                            ByVal lpsz2 As String _
                            ) As LongPtr
Private Declare PtrSafe _
            Function PostMessageA Lib "user32" ( _
                            ByVal hwnd As LongPtr, _
                            ByVal wMsg As Long, _
                            ByVal wParam As LongPtr, _
                            ByVal lParam As LongPtr _
                            ) As Long
Private Declare PtrSafe _
            Sub keybd_event Lib "user32" ( _
                            ByVal bVk As Byte, _
                            ByVal bScan As Byte, _
                            ByVal dwFlags As Long, _
                            ByVal dwExtraInfo As LongPtr)

Private Const WM_ACTIVATE As Long = &H6
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_CONTROL = &H11

Sub ClearImmediateWindow()

    Dim hwndVBE As LongPtr
    Dim hwndImmediate As LongPtr
    
    hwndVBE = FindWindowA("wndclass_desked_gsk", vbNullString)
    hwndImmediate = FindWindowExA(hwndVBE, ByVal 0&, "VbaWindow", "Immediate")
    PostMessageA hwndImmediate, WM_ACTIVATE, 1, 0&
    
    keybd_event VK_CONTROL, 0, 0, 0
    keybd_event vbKeyA, 0, 0, 0
    keybd_event vbKeyA, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
    
    keybd_event vbKeyDelete, 0, 0, 0
    keybd_event vbKeyDelete, 0, KEYEVENTF_KEYUP, 0
    
End Sub

Answer 16

感谢 ProfoundlyOblivious，

没有 SendKeys，请检查
没有 VBA 可扩展性，请检查
没有第 3 方可执行文件，请检查
一个小问题：

本地化 Office 版本为即时窗口使用另一个标题。在荷兰语中，它被命名为“Direct”。
我添加了一行来获取本地化的标题，以防 FindWindowExA 失败。对于同时使用 MS-Office 英文版和荷兰文版的用户。

为您完成大部分工作 +1！

Option Explicit

Private Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowExA Lib "user32" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function PostMessageA Lib "user32" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)

Private Const WM_ACTIVATE As Long = &H6
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_CONTROL = &H11

Public Sub ClearImmediateWindow()
    Dim hwndVBE As LongPtr
    Dim hwndImmediate As LongPtr
    
    hwndVBE = FindWindowA("wndclass_desked_gsk", vbNullString)
    hwndImmediate = FindWindowExA(hwndVBE, ByVal 0&, "VbaWindow", "Immediate") ' English caption
    If hwndImmediate = 0 Then hwndImmediate = FindWindowExA(hwndVBE, ByVal 0&, "VbaWindow", "Direct") ' Dutch caption
    PostMessageA hwndImmediate, WM_ACTIVATE, 1, 0&
    
    keybd_event VK_CONTROL, 0, 0, 0
    keybd_event vbKeyA, 0, 0, 0
    keybd_event vbKeyA, 0, KEYEVENTF_KEYUP, 0
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
   
    keybd_event vbKeyDelete, 0, 0, 0
    keybd_event vbKeyDelete, 0, KEYEVENTF_KEYUP, 0
End Sub

Answer 17

当从更高级别的子例程调用 ClearImmediate 函数时，上面发布的所有解决方案都存在问题。例如，以下内容通常会以 EMPTY 即时窗口结束！

sub HigherLevel
   debug.print "this message should disappear in 1 second"
   call AnyOfAboveSolutions
   debug.print "This message should appear in the immediate window"
End sub

但多年后，我终于找到了一个可行的解决方案。 首先将以下内容安装到您的 VBA 项目中。

    Option Explicit
Const Source = "c:\users\rdbmdl\"
Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub cls() ' also known as ClearScreen and ClearImmediateWindow
' see https://www.experts-exchange.com/questions/29228246/Vba-subroutines-to-clear-the-IDE-immediate-window-do-not-always-work.html

  ' the Cls routine Clears the immediate window during debugging.
  ' To install it you must create c:\users\rdbmdl\Vbaf5.vbs.
  ' if invoked from a runtime environment  ClearScreen will become disabled.

Dim safe As Single, ap As Object
Static Initialized As Boolean, Disabled As Boolean
    If Not Initialized Then
        Initialized = True
        If Dir(Source & "vbaf5.vbs") = "" Then
            MsgBox "Please install VbaF5.vbs"
            Disabled = True
        End If
    End If
    If Disabled Then Exit Sub
    safe = VBA.DateTime.Timer
    Shell Replace("wscript c:\users\rdbMdl\vbaf5.vbs ""%1""", "%1", GetCurrentProcessId), 1
Stop ' in a runtime environment Stop is ignored and ClearScreen gets disabled
      ' the Stop CANNOT be replaced with a Sleep. Things get very weird vba code that calls Cls gets a few bytes deleted.
    If VBA.DateTime.Timer - safe < 0.01 Then
       Disabled = True
    End If
End Sub

然后将以下安装到C:\users\rdbmdl\vbaF5.vbs

' see https://www.experts-exchange.com/questions/29228246/Vba-subroutines-to-clear-the-IDE-immediate-window-do-not-always-work.html
Dim objServices, objProcessSet, process, desired
    desired = "^g^a {DEL} {HOME}"
    desired = desired & "{F7}^+{F2}{RIGHT}+{RIGHT}"
    desired = desired & "{F5}"

    Set objShell = wscript.CreateObject("WScript.Shell")
    Set objargsinall = wscript.Arguments'
    Set objServices = GetObject("winmgmts:\\.\root\CIMV2")
    Set objProcessSet = objServices.ExecQuery("SELECT ProcessID FROM Win32_Process WHERE ProcessID =" & objargsinall(0), , 48)
   
    For Each process In objProcessSet
    objShell.AppActivate (process.ProcessID)
    objShell.SendKeys desired   
    Next
' see https://www.experts-exchange.com/questions/29228246/Vba-subroutines-to-clear-the-IDE-immediate-window-do-not-always-work.html

Answer 18

我 2021 年 11 月 17 日的回答使用了 vbscript，而且相当复杂。
以下更简单，完全是 VBA。 95% 的情况下，ClearStop 是最佳解决方案，但如果您使用 debug.print 来帮助测量长时间运行的程序中的资源消耗，ClearGo 会很有用。

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Sub ClearStop()
    Application.SendKeys "^g^a^{DEL}"
    Stop
End Sub
Sub ClearGo()
    Application.SendKeys "^g^a^{DEL}" & IIf(GetKeyState(&H10) < 0, "", "{F5}")   'Shift key: see https://www.experts-exchange.com/questions/29228246/Vba-subroutines-to-clear-the-IDE-immediate-window-do-not-always-work.html
    Stop
End Sub