使用VBA清除即时窗口？

Question

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

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

Answer 1

以下是此处的解决方案

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

Answer 2

我设想的更难做到这一点.我在 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

Answer 3

SendKeys是直的,但您可能不喜欢它(例如,如果它关闭,它会打开立即窗口,并移动焦点).

WinAPI + VBE方式非常复杂,但您可能希望不授予VBA访问VBE(甚至可能是您的公司组策略).

而不是清除你可以用空格清除其内容(或其中的一部分......):

Debug.Print String(65535, vbCr)

不幸的是,这仅在插入位置位于立即窗口的末尾时才起作用(插入字符串,不附加).如果您只通过Debug.Print发布内容并且不以交互方式使用该窗口,则可以完成此任务.如果您主动使用该窗口并偶尔导航到内容中,这并没有多大帮助.

Answer 4

甚至更简单

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

Answer 5

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

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

为了完整起见，@Austin D 注意到：

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

Answer 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

我不喜欢删除Immediate内容(害怕意外删除代码,因此以上是对你所写的一些代码的攻击.

这解决了Akos Groller上面写到的问题: "不幸的是,这只有在插入位置位于立即窗口的末尾时才有效 "

代码打开立即窗口(或将焦点放在它上面),发送一个CTRL + END,然后是大量的换行符,因此以前的调试内容不可见.

请注意, DoEvents是至关重要的,否则逻辑将失败(插入位置不会及时移动到立即窗口的末尾).