更简单

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

恩德凯斯是直截了当的,但你可能不喜欢(例如,如果关闭,就会打开立即窗户,转移重点)。

WinAPI + VBE办法确实很详细,但你可能不准许VBA进入VBE(甚至不是你的公司集团政策)。

不要将其内容输入(或部分内容......),而不要将其内容移至空白处:

Debug.Print String(65535, vbCr)

不幸的是,只有在护理站在紧凑窗口结束时(插插插图,不附后)才会奏效。 如果你只通过“ De”张贴内容。 印刷和不以互动方式使用窗户,将做这项工作。 如果你积极利用窗户,有时在内容上行走,那就无济于事。

我所设想的要做更多的工作。 见http://www.excel-answers.com/microsoft/Excel-Programing/31899691/clearing-immediate-window-in-vba-by-code.aspx“rel=“noretinger”>。 采用可避免翻新的<代码>骑手的固定设备

从一个固定单元进行。

由于最初的职位错失了《私人功能宣言》――贵重的复印件和您真正的工作。

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

I do not like deleting the Immediate content (fear of deleting the code by accident, so the above is a hack on some of the code you all wrote.

This handles the problem Akos Groller writes about above: "Unfortunately, this only works if the caret position is at the end of the Immediate window"

The code opens the Immediate window (or puts the focus on it), sends a CTRL+END, followed by a flood of newlines, so the previous debug content is not in sight.

Please note, that DoEvents is crucial, otherwise the logic would fail (the caret position would not move in time to the end of the Immediate window).

Marked answer does not work if triggered via button in worksheet. It opens Go To excel dialog box as CTRL+G is shortcut for. You have to SetFocus on Immediate Window before. You may need also DoEvent if you want to Debug.Print right after clearing.

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

如@Austin D所示:

For those wondering, the shortcut keys are Ctrl+G (to activate the Immediate window), then Ctrl+A (to select everything), then Del (to clear it).

• No SendKeys?
• No VBA Extensibility?
• No 3rd Party Executables?
• No problem!

A Windows API Solution

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

Thanks ProfoundlyOblivious,

No SendKeys, check
No VBA Extensibility, check
No 3rd Party Executables, check
One minor problem:

Localised Office versions use another caption for the immediate window. In Dutch it is named "Direct".
I have added one line to get the localised caption in case FindWindowExA fails. For those who use both the English and Dutch version of MS-Office.

+1 for you for doing most of the work!

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

在进行了一些试验之后,我对我手法做了一些改动:

1. Trap errors (the original code is falling over due to not setting a reference to "VBE", which I also changed to myVBE for clarity)
2. Set the Immediate window to visible (just in case!)
3. Commented out the line to return the focus to the original window as it s this line that causes the code window contents to be deleted on machines where timing issues occur (I verified this with PowerPoint 2013 x32 on Win 7 x64). It seems the focus is switching back before SendKeys has completed, even with Wait set to True!
4. Change the wait state on SendKeys as it doesn t seem to be adhered to on my test environment.

我还指出,该项目必须具备对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

关于清洁Immediate 窗口一使用(VBA Excel2016)的下一个功能:

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

But direct call of ClrImmediate() like this:

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

works only if i put the breakpoint on Debug.Print, otherwise the clearing will be done after execution of ShowCommandBarNames() - NOT before Debug.Print. Unfortunately, call of DoEvents() did not help me... And no matter: TRUE or FALSE is set for SendKeys.

To solve this I use next couple of calls:

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

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

在我看来,使用申请。 关于时间,可能非常有助于BA IDE的方案拟订工作。 在这种情况下,可以使用Serial(0,0,0>。

上述所有解决方案都存在问题,因为从较高层次的分行中召唤了排雷中心的职能。 举例来说,以下几段内容通常会以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

But after many years I finally found a solution that works. First install the following to your VBA project.

    Option Explicit
Const Source = "c:users
dbmdl"
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
dbmdlVbaf5.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
dbMdlvbaf5.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

Then install the following to C:users dbmdlvbaF5.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:\.
ootCIMV2")
    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

My 11/17/2021 answer used vbscript and was fairly complicated.
The following is MUCH simpler and is entirely VBA. 95% of the time ClearStop is the best solution, but ClearGo is useful if you are using debug.print to help measure resource consumption in long running programs.

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

I m in favor of not ever depending on the shortcut keys, as it may work in some languages but not all of them... Here s my humble contribution:

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

在2016年Excel进行公正的检查,这部法典为我工作:

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

如果你会在这里使用自动取款机,则使用第一稿。

The key command is Ctrl+Delete. It only works if the VBE is active.
When pressed it will clear the immediate window and then activate the code editor, via F7.

我往往想立即澄清一下,在我这样的时候,我只能打上<条码>。

#IfWinActive, ahk_class wndclass_desked_gsk

^Delete:: clearImmediateWindow()

#If

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

解决问题:

1. Clear the immediate window
2. After clearing the immediate window, further Debug.Print statements don t work
3. SendKeys sometimes Toggles NumLock (Microsoft Bug)

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

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

我根据上述所有意见测试了该守则。 Seems to work flessly. 评论?

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超支限额。 这种方法与这种方法类似,但效果很大。

Sub clearDebug()
    SendKeys "^g^a{DEL}"
End Sub