使用VBA清除即时窗口？

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

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

下面是从这里的解决scheme 

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

我设想的难度更大。 我通过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

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

WinAPI + VBE的方式真的很精巧，但是您不希望授予VBA对VBE的访问权限（甚至可能不是您的公司组策略）。

而不是清理，你可以清空其内容（或其中的一部分…）与空白： 

 Debug.Print String(65535, vbCr)

不幸的是，这只有在脱字符位置在即时窗口的末尾时（插入string，不附加）才有效。 如果您只通过Debug.Print发布内容，而不交互使用该窗口，则可以完成这项工作。 如果您主动使用该窗口，偶尔导航到内容中，这并没有太大的帮助。

甚至更简单 

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

这是一个想法的组合（用Excel VBA 2007testing）：

'*（这可以代替你的日常调用debugging） 

 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，然后是大量换行符，因此以前的debugging内容不可见。

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

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

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

经过一番尝试，我做了一些mod的mehow的代码如下：

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

我还注意到，该项目必须信任启用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 
 Sub ClearImmediateWindow() SendKeys "^{g}", False DoEvents SendKeys "^{Home}", False SendKeys "^+{End}", False SendKeys "{Del}", False SendKeys "{F7}", False End Sub

我赞成不要依靠快捷键，因为它可能在某些语言中工作，但不是全部……这是我的卑微的贡献： 

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

清理立即窗口我使用（VBA Excel 2016）下一个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

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

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

只有当我把断点放在Debug.Print ，否则清除将在执行ShowCommandBarNames()之后完成 – ShowCommandBarNames() Debug.Print之前。 不幸的是， DoEvents()调用并没有帮助我……而且无论如何： SendKeys都设置为TRUE或FALSE 。

为了解决这个问题，我使用了几个电话： 

 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 ） 。

Interesting Posts