>有谁知道如何使用VBA清除即时窗口？
虽然我总是可以自己手动清除它，但我很好奇是否有办法以编程方式执行此操作。
以下是这里的解决方案
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
甚至更简单
Sub clearDebugConsole()
For i = 0 To 100
Debug.Print ""
Next i
End Sub
SendKeys 是直的，但您可能不喜欢它（例如，如果关闭，它会打开"即时"窗口，并移动焦点）。
WinAPI + VBE的方式非常详细，但您可能不希望授予VBA对VBE的访问权限（甚至可能是您的公司组策略不这样做）。
您可以用空白将其内容（或部分内容...）清除，而不是清除：
Debug.Print String(65535, vbCr)
不幸的是，这仅在插入符号位置位于"即时"窗口的末尾时才有效（字符串是插入的，而不是附加的）。如果您只通过 Debug.Print 发布内容并且不以交互方式使用该窗口，这将完成这项工作。如果您主动使用该窗口并偶尔导航到内容，则这无济于事。
我想象的要困难得多。我在这里找到了一个由keepitcool的版本，避免了可怕的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)
' HKLMSOFTWAREMicrosoftOffice11.0ExcelSecurity
' 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
以下是一些想法的组合（使用 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 至关重要，否则逻辑将失败（插入符号位置不会及时移动到"即时"窗口的末尾）。
如果通过工作表中的按钮触发，标记的答案不起作用。它打开"转到 excel"对话框，因为 CTRL+G 是快捷方式。您必须在"即时窗口"上设置焦点。如果您想在清除后立即Debug.Print，您可能还需要DoEvent。
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^g ^a {DEL}"
DoEvents
为了完整起见，正如@Austin D所指出的：
对于那些想知道的人，快捷键是 Ctrl+G（激活 即时窗口），然后按 Ctrl+A（选择所有内容），然后 Del（到 清除它）。
- 没有发送密钥？
- 没有 VBA 扩展性？
- 没有第三方可执行文件？
- 没关系！
一个视窗 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
我遇到了同样的问题。以下是我在Microsoft链接的帮助下解决问题的方式：https://msdn.microsoft.com/en-us/library/office/gg278655.aspx
Sub clearOutputWindow()
Application.SendKeys "^g ^a"
Application.SendKeys "^g ^x"
End Sub
非常感谢遗忘，
没有发送键，请检查
没有 VBA 扩展性，请检查
没有第三方可执行文件，请检查
一个小问题：
本地化的 Office 版本为即时窗口使用另一个标题。在荷兰语中，它被命名为"直接"。
我添加了一行来获取本地化标题，以防 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
经过一番实验，我对mehow的代码做了一些修改，如下所示：
- 陷阱错误（由于没有设置对"VBE"的引用，原始代码正在失败，为了清楚起见，我也将其更改为myVBE）
- 将"即时"窗口设置为可见（以防万一！
- 注释掉了该行以将焦点返回到原始窗口，因为正是这一行导致在发生计时问题的计算机上删除代码窗口内容（我在 Win 2013 x32 x64 上验证了这一点）。似乎焦点在发送密钥完成之前切换回来，即使"等待"设置为 True！
- 更改 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
用于清洁我使用的即时窗口（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()后完成 - 而不是在调试.打印之前。 不幸的是，DoEvents()的呼唤并没有帮助我...不管怎样：为 SendKeys 设置了 TRUE 或 FALSE。
为了解决这个问题，我使用以下几个调用：
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）。
我的 11/17/2021 答案使用 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
我赞成永远不依赖快捷键，因为它可能适用于某些语言，但不是所有语言......以下是我的微薄贡献：
Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
Debug.Print VBA.String(200, vbNewLine)
End Sub
> 刚刚在Excel 2016中检查，这段代码对我有用：
Sub ImmediateClear()
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^{END} ^+{HOME}{DEL}"
End Sub
如果您碰巧使用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}
}
上面发布的所有解决方案在从更高级别的子例程调用 ClearImmediate 函数时都存在问题。例如，以下内容通常会以空的即时窗口结束！
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:usersrdbmdl"
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:usersrdbmdlVbaf5.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:usersrdbMdlvbaf5.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:\.rootCIMV2")
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
我正在使用这个短代码：
Sub clearDebug()
SendKeys "^g^a{DEL}"
End Sub
要解决的问题：
- 清除即时窗口
- 清除即时窗口后，进一步的 Debug.Print 语句不起作用
- 发送键有时会切换数字锁（Microsoft错误）
Option Explicit
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Sub TestClearImmediateWindow()
Dim x As Integer
For x = 1 To 10
Debug.Print String(20, Chr(64 + x))
Next x
ClearImmediateWindow
Call Application.OnTime(DateAdd("s", 1, Now), "DoNextThing")
End Sub
Private Sub ClearImmediateWindow()
Const NUMLOCKKEYCODE = 144
Dim NumLockState As Integer
NumLockState = GetKeyState(NUMLOCKKEYCODE)
Call Application.SendKeys("^g^a{DEL}{F7}", True) ' Because of a bug, this line sometimes toggles NumLock
If NumLockState <> GetKeyState(NUMLOCKKEYCODE) Then Call Application.SendKeys("{NUMLOCK}", True)
End Sub
Private Sub DoNextThing()
Dim x As Integer
For x = 1 To 10
Debug.Print String(20, Chr(74 + x))
Next x
End Sub
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^a", True
Application.SendKeys "{DEL}", True
如果错误：对 Visual Basic 项目的编程访问不受信任
Sub ClearImmediateWindow()
SendKeys "^{g}", False
DoEvents
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
SendKeys "{F7}", False
End Sub
我根据上面的所有注释测试了这段代码。似乎完美无缺。评论？
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
以前使用过利用 200 行缓冲区溢出限制的Debug.Print String(200, chr(10))。不太喜欢这种方法，但它有效。