有谁知道如何使用 VBA 清除即时窗口？
虽然我总是可以自己手动清除它，但我很好奇是否有办法以编程方式执行此操作。
问问题
119017 次
19 回答
35
以下是来自这里的解决方案
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
于 2012-06-20T11:52:01.090 回答
25
甚至更简单
Sub clearDebugConsole()
For i = 0 To 100
Debug.Print ""
Next i
End Sub
于 2014-06-16T09:46:33.463 回答
24
SendKeys 是直接的，但您可能不喜欢它（例如，如果它关闭，它会打开立即窗口，并移动焦点）。
WinAPI + VBE 的方式非常精细，但您可能不希望授予 VBA 对 VBE 的访问权限（甚至可能是您的公司组策略不允许）。
您可以用空白将其内容（或其中的一部分......）清除，而不是清除：
Debug.Print String(65535, vbCr)
不幸的是，这仅在插入符号位置位于立即窗口的末尾时才有效（插入字符串，未附加）。如果您只通过 Debug.Print 发布内容并且不以交互方式使用该窗口，这将完成这项工作。如果您积极使用窗口并偶尔导航到内容中，这并没有太大帮助。
于 2012-11-23T07:50:51.003 回答
23
要做到我所设想的要困难得多。我在这里找到了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)
' 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
于 2012-04-18T05:43:17.937 回答
7
这是一个想法的组合（使用 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 是至关重要的，否则逻辑将失败（插入符号位置不会及时移动到即时窗口的末尾）。
于 2015-02-07T05:47:38.453 回答
4
如果通过工作表中的按钮触发，标记的答案将不起作用。它打开转到 excel 对话框，因为 CTRL+G 是快捷方式。您必须先在即时窗口上设置焦点。DoEvent如果您想Debug.Print在清除后立即进行操作，您可能还需要。
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^g ^a {DEL}"
DoEvents
为了完整起见，正如@Austin D 注意到的那样：
对于那些想知道的人，快捷键是 Ctrl+G（激活立即窗口），然后是 Ctrl+A（选择所有内容），然后是 Del（清除它）。
于 2018-04-12T11:42:43.177 回答
3
我有同样的问题。以下是我在 Microsoft 链接的帮助下解决问题的方法：https ://msdn.microsoft.com/en-us/library/office/gg278655.aspx
Sub clearOutputWindow()
Application.SendKeys "^g ^a"
Application.SendKeys "^g ^x"
End Sub
于 2017-05-02T21:15:22.363 回答
3
- 没有发送密钥？
- 没有 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
于 2020-07-04T20:59:52.587 回答
2
经过一些实验，我对mehow的代码做了一些修改，如下所示：
- 陷阱错误（原始代码由于未设置对“VBE”的引用而失败，为了清楚起见，我也将其更改为 myVBE）
- 将立即窗口设置为可见（以防万一！）
- 注释掉该行以将焦点返回到原始窗口，因为正是这一行导致代码窗口内容在发生计时问题的机器上被删除（我在 Win 7 x64 上使用 PowerPoint 2013 x32 验证了这一点）。似乎焦点在 SendKeys 完成之前切换回来，即使 Wait 设置为 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
于 2014-03-03T21:11:52.783 回答
1
为了清理即时窗口，我使用（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，否则将在执行-NOTShowCommandBarNames() 之前Debug.Print之后完成清除。不幸的是，调用 ofDoEvents()并没有帮助我......而且无论：为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 )。
于 2017-12-04T22:44:10.887 回答
1
谢谢 ProfoundlyOblivious，
没有 SendKeys，检查
没有 VBA 可扩展性，检查
没有 3rd Party Executables，检查
一个小问题：
本地化 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
于 2020-10-25T14:08:12.900 回答
1
我 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
于 2021-11-28T23:48:09.087 回答
0
我赞成永远不要依赖快捷键，因为它可能适用于某些语言，但并非全部适用......这是我的谦虚贡献：
Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
Debug.Print VBA.String(200, vbNewLine)
End Sub
于 2017-11-08T18:12:35.227 回答
0
刚刚签入 Excel 2016，这段代码对我有用：
Sub ImmediateClear()
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^{END} ^+{HOME}{DEL}"
End Sub
于 2019-10-08T19:15:02.927 回答
0
如果您碰巧使用 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}
}
于 2020-03-06T02:13:15.667 回答
0
当从更高级别的子例程调用 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
于 2021-11-17T12:47:33.630 回答
0
我正在使用这个短代码：
Sub clearDebug()
SendKeys "^g^a{DEL}"
End Sub
于 2022-01-20T15:44:59.627 回答
-1
Sub ClearImmediateWindow()
SendKeys "^{g}", False
DoEvents
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
SendKeys "{F7}", False
End Sub
于 2016-09-15T02:25:39.050 回答
-1
我根据上面的所有评论测试了这段代码。似乎完美无缺。评论？
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 行的 Buffer 溢出限制。不太喜欢这种方法，但它确实有效。
于 2018-10-05T11:47:37.770 回答