Use VBA to Clear Immediate Window?

前端 未结 16 960
刺人心
刺人心 2021-01-30 00:19

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

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

相关标签:
16条回答
  • 2021-01-30 00:41

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

    0 讨论(0)
  • 2021-01-30 00:42

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

    0 讨论(0)
  • 2021-01-30 00:46

    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
    
    0 讨论(0)
  • 2021-01-30 00:47
    • 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
    
    0 讨论(0)
  • 2021-01-30 00:48

    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
    
    0 讨论(0)
  • 2021-01-30 00:49

    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
    
    0 讨论(0)
提交回复
热议问题