有谁知道如何使用VBA清除即时窗口？
虽然我总是可以手动清除它，但我很好奇是否有办法以编程方式执行此操作。
答案 0 :(得分：27)
以下是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
答案 1 :(得分：23)
我设想的更难做到这一点。我发现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
答案 2 :(得分：16)
SendKeys是直的，但您可能不喜欢它（例如，如果它关闭，它会打开立即窗口，并移动焦点）。
WinAPI + VBE方式非常复杂，但您可能希望不授予对VBE的VBA访问权限（甚至可能是您的公司组策略）。
而不是清除你可以用空格清除其内容（或其中的一部分......）：
Debug.Print String(65535, vbCr)
不幸的是，这仅在插入位置位于立即窗口的末尾时才起作用（插入字符串，而不是追加）。如果您只通过Debug.Print发布内容并且不以交互方式使用该窗口，则可以完成此任务。如果您主动使用该窗口并偶尔导航到内容中，这无济于事。
答案 3 :(得分：14)
甚至更简单
Sub clearDebugConsole()
For i = 0 To 100
Debug.Print ""
Next i
End Sub
答案 4 :(得分：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至关重要，否则逻辑将失败 （插入位置不会及时移动到立即窗口的末尾）。
答案 5 :(得分：2)
经过一些实验，我对mehow的代码做了一些修改，如下所示：
我还注意到项目必须信任启用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
答案 6 :(得分：2)
我遇到了同样的问题。以下是我通过Microsoft链接帮助解决问题的方法：https://msdn.microsoft.com/en-us/library/office/gg278655.aspx
Sub clearOutputWindow()
Application.SendKeys "^g ^a"
Application.SendKeys "^g ^x"
End Sub
答案 7 :(得分：1)
Sub ClearImmediateWindow()
SendKeys "^{g}", False
DoEvents
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
SendKeys "{F7}", False
End Sub
答案 8 :(得分：1)
我赞成不依赖快捷键，因为它可能适用于某些语言但不是全部... 这是我的谦逊贡献：
Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
Debug.Print VBA.String(200, vbNewLine)
End Sub
答案 9 :(得分：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上时才有效，否则清除将在执行ShowCommandBarNames()之后完成 - 而不是在 Debug.Print 之前。
不幸的是，调用DoEvents()对我没有帮助......无论如何： TRUE 或 FALSE 是为 SendKeys 设置的。< / p>
要解决这个问题，我会使用下面几个电话：
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 ）。
答案 10 :(得分：1)
如果通过工作表中的按钮触发，则标记的答案不起作用。它打开Go To excel对话框，因为CTRL + G是快捷方式。您必须先在立即窗口上设置SetFocus。如果您想在清算后立即DoEvent，则可能还需要Debug.Print。
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^g ^a {DEL}"
DoEvents
为了完整，正如@Austin D注意到的那样：
对于那些想知道，快捷键是Ctrl + G（激活 立即窗口），然后按Ctrl + A（选择所有内容），然后Del（转到 清除它。）
答案 11 :(得分：0)
只需在Excel 2016中进行检查，这段代码就对我有用：
Sub ImmediateClear()
Application.VBE.Windows("Immediate").SetFocus
Application.SendKeys "^{END} ^+{HOME}{DEL}"
End Sub
答案 12 :(得分：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}
}
答案 13 :(得分：0)
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
答案 14 :(得分：-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行的缓冲区溢出限制。不太喜欢这种方法，但是可以用。
答案 15 :(得分：-1)
深表感谢，
没有SendKeys，请检查
没有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