使用 VBA 清除立即窗口？

Use VBA to Clear Immediate Window?

提问by Alpha

Does anyone know how to clear the immediate window using VBA?

有谁知道如何使用 VBA 清除即时窗口？

While I can always clear it myself manually, I am curious if there is a way to do this programmatically.

虽然我总是可以自己手动清除它，但我很好奇是否有办法以编程方式执行此操作。

采纳答案by 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

回答by brettdj

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

要做到我所设想的要困难得多。我在这里找到了keeitcool的一个版本，它避免了可怕的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.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

回答by Akos Groller

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

SendKeys 是直接的，但你可能不喜欢它（例如，如果它关闭，它会打开立即窗口，并移动焦点）。

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

WinAPI + VBE 方式非常复杂，但您可能不希望授予 VBA 对 VBE 的访问权限（甚至可能是您公司的组策略不允许）。

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.

不幸的是，这只适用于插入符号位置在立即窗口的末尾（字符串被插入，而不是附加）。如果您只通过 Debug.Print 发布内容并且不以交互方式使用窗口，这将完成这项工作。如果您主动使用窗口并偶尔导航到内容中，这不会有太大帮助。

回答by Sebastian Viereck

or even more simple

或者更简单

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

回答by El Scripto

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

这是一个想法的组合（用 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 endof the Immediate window"

这解决了 Akos Groller 在上面写的问题： “不幸的是，这仅在插入符号位置位于立即窗口的末尾时才有效”

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.

代码打开立即窗口（或将焦点放在它上面），发送 CTRL+END，然后是大量换行符，因此看不到先前的调试内容。

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

请注意， DoEvents 是至关重要的，否则逻辑将失败（插入符号位置不会及时移动到立即窗口的末尾）。

回答by Artur Fityka

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 DoEventif you want to Debug.Printright after clearing.

如果通过工作表中的按钮触发，标记的答案不起作用。它打开转到 Excel 对话框，因为 CTRL+G 是快捷方式。您必须先在立即窗口上设置焦点。DoEvent如果您想Debug.Print在清除后立即使用，您可能还需要。

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

For completeness, as @Austin D noticed:

为了完整起见，正如@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).

对于那些想知道的人，快捷键是 Ctrl+G（激活立即窗口），然后是 Ctrl+A（选择所有内容），然后是 Del（清除它）。

回答by 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

我有同样的问题。以下是我在 Microsoft 链接的帮助下解决问题的方法：https: //msdn.microsoft.com/en-us/library/office/gg278655.aspx

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

回答by Jamie Garroch

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

经过一些试验，我对 mehow 的代码做了一些修改，如下所示：

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.

1. 陷阱错误（原始代码由于未设置对“VBE”的引用而失败，为了清楚起见，我也将其更改为 myVBE）
2. 将立即窗口设置为可见（以防万一！）
3. 注释掉将焦点返回到原始窗口的行，因为正是这一行导致代码窗口内容在发生计时问题的机器上被删除（我在 Win 7 x64 上使用 PowerPoint 2013 x32 验证了这一点）。似乎焦点在 SendKeys 完成之前切换回来，即使 Wait 设置为 True！
4. 更改 SendKeys 上的等待状态，因为它在我的测试环境中似乎没有得到遵守。

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

我还注意到项目必须信任启用的 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

回答by Fernando Fernandes

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

回答by Leon Rom

For cleaning Immediatewindow I use (VBA Excel 2016) next 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

But direct call of ClrImmediate()like this:

但是ClrImmediate()像这样直接调用：

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: TRUEor FALSEis set for SendKeys.

仅当我设置断点时才有效Debug.Print，否则清除将在执行后完成ShowCommandBarNames()-不在 Debug.Print之前。不幸的是， call ofDoEvents()并没有帮助我......而且无论：为SendKeys设置了TRUE还是FALSE。

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.OnTimemight be very useful in programming for VBA IDE. In this case it's can be used even TimeSerial(0, 0, 0).

在我看来，在 VBA IDE 编程中使用Application.OnTime可能非常有用。在这种情况下，它甚至可以使用TimeSerial(0, 0, 0)。