Use VBA to Clear Immediate Window?

牧云@^-^@ 提交于 2019-12-02 14:22:00
Blaz Brencic

Below is a solution from 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

Much harder to do that I'd envisaged. I found an version here by keepitcool that avoids the dreaded Sendkeys

Run this from a regular module.

Updated as initial post missed the Private Function Declarations - poor copy and paste job by yours truly

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

SendKeys is straight, but you may dislike it (e.g. it opens the Immediate window if it was closed, and moves the focus).

The WinAPI + VBE way is really elaborate, but you may wish not to grant VBA access to VBE (might even be your company group policy not to).

Instead of clearing you can flush its content (or part of it...) away with blanks:

Debug.Print String(65535, vbCr)

Unfortunately, this only works if the caret position is at the end of the Immediate window (string is inserted, not appended). If you only post content via Debug.Print and don't use the window interactively, this will do the job. If you actively use the window and occasionally navigate to within the content, this does not help a lot.

or even more simple

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

Here is a combination of ideas (tested with excel vba 2007) :

' * (this can replace your day to day calling to debug)

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).

After some experimenting, I made some mods to mehow's code as follows:

  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.

I also noted that the project must have trust for the VBA project object model enabled.

' 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
TheRealJD

I had the same problem. Here is how I resolved the issue with help from the Microsoft link: https://msdn.microsoft.com/en-us/library/office/gg278655.aspx

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

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

For completeness, as @Austin D noticed:

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).

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

For cleaning Immediate window I use (VBA Excel 2016) next function:

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

It seems to me that using Application.OnTime might be very useful in programming for VBA IDE. In this case it's can be used even TimeSerial(0, 0, 0).

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

Just checked in Excel 2016 and this piece of code worked for me:

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

I tested this code based on all the comments above. Seems to work flawlessly. Comments?

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

Previously used the Debug.Print String(200, chr(10)) which takes advantage of the Buffer overflow limit of 200 lines. Didn't like this method much but it works.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!