Użyj VBA, aby wyczyścić natychmiastowe okno?

Czy ktoś wie jak wyczyścić okno za pomocą VBA?

Chociaż zawsze mogę to wyczyścić ręcznie, jestem ciekaw, czy istnieje sposób, aby to zrobić programowo.

Author: Paradox, 2012-04-18

12 answers

Poniżej znajduje się rozwiązanie z Tutaj

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
 23
Author: Blaz Brencic,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2016-02-12 05:35:34

O wiele trudniej to przewidzieć. Znalazłem wersję tutaj autorstwa keepitcool, która unika przerażających Sendkeys

Uruchom to ze zwykłego modułu.

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
 22
Author: brettdj,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2013-03-21 05:44:54

SendKeys jest prosty, ale możesz go nie lubić(np. otwiera okno natychmiastowe, jeśli było zamknięte i przesuwa ostrość).

Sposób WinAPI + VBE jest bardzo rozbudowany, ale możesz nie chcieć przyznawać VBA dostępu do VBE(może nawet twoja polityka grupy firm nie).

Zamiast czyszczenia można spłukać jego zawartość (lub jej część... Precz z pustkami:

Debug.Print String(65535, vbCr)

Niestety, działa to tylko wtedy, gdy pozycja karetki znajduje się na końcu bezpośredniego okna (łańcuch jest wstawiany, nie dołączany). Jeśli publikujesz treść tylko przez debugowanie.Drukuj i nie używaj interaktywnie okna, to wykona zadanie. Jeśli aktywnie korzystasz z okna i od czasu do czasu nawigujesz do zawartości, nie pomaga to zbytnio.

 15
Author: Akos Groller,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2012-11-23 14:24:25

Lub jeszcze bardziej proste

Sub clearDebugConsole()
    For i = 0 To 100
        Debug.Print ""
    Next i
End Sub
 14
Author: Sebastian Viereck,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-06-09 17:36:34

Oto połączenie pomysłów (testowane z excel vba 2007):

' * (może to zastąpić codzienne wywołanie do debugowania)

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

Nie lubię usuwać natychmiastowych treści (strach przed usunięciem kodu przez przypadek, tak więc powyższe jest hack na niektóre z kodu, które napisaliście.

To rozwiązuje problem, o którym pisze Akos Groller powyżej: "niestety, to działa tylko wtedy, gdy pozycja karetki jest na końcu z the Immediate okno "

Kod otwiera okno natychmiastowe (lub skupia się na nim), wysyła CTRL + END, po którym następuje zalanie nowych linii, więc poprzednia zawartość debugowania nie jest widoczna.

Należy pamiętać, że DoEvents jest kluczowe, w przeciwnym razie logika zawiedzie (pozycja karetki nie przesunie się w czasie do końca bezpośredniego okna).

 5
Author: El Scripto,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-02-07 05:47:38

Po kilku eksperymentach zrobiłem kilka modów do kodu mehow w następujący sposób:

  1. błędy Trap (oryginalny kod spada z powodu nie ustawiania odniesienia do "VBE" , które również zmieniłem na myVBE dla jasności)
  2. Ustaw natychmiastowe okno na widoczne (na wszelki wypadek!)
  3. skomentował linię, aby przywrócić fokus do oryginalnego okna, ponieważ to ta linia powoduje usunięcie zawartości okna kodu na komputerach, na których występują problemy z czasem (zweryfikowałem to z PowerPoint 2013 x32 na Win 7 x64). Wydaje się, że fokus jest przełączanie z powrotem przed SendKeys zakończone, nawet z Wait ustawione na True!
  4. Zmień stan oczekiwania na SendKeys, ponieważ nie wydaje się być przestrzegany w moim środowisku testowym.

Zauważyłem również, że projekt musi mieć zaufanie do włączonego modelu obiektowego projektu 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
 2
Author: Jamie Garroch,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2014-03-03 21:11:52

Miałem ten sam problem. Oto jak rozwiązałem problem z Pomocą z linku Microsoft: https://msdn.microsoft.com/en-us/library/office/gg278655.aspx

Sub clearOutputWindow()
  Application.SendKeys "^g ^a"
  Application.SendKeys "^g ^x"
End Sub
 2
Author: TheRealJD,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-05-02 21:26:03
Sub ClearImmediateWindow()
    SendKeys "^{g}", False
    DoEvents
    SendKeys "^{Home}", False
      SendKeys "^+{End}", False
      SendKeys "{Del}", False
        SendKeys "{F7}", False
End Sub
 1
Author: Mike Rodriguez,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2016-09-15 02:54:03

Jestem za tym, aby nigdy nie zależeć od klawiszy skrótu, ponieważ może działać w niektórych językach, ale nie we wszystkich... Oto mój skromny wkład:

Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
    Debug.Print VBA.String(200, vbNewLine)
End Sub
 1
Author: Fernando Fernandes,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-11-08 18:32:49

Do czyszczenia natychmiastowe okno używam (VBA Excel 2016) następna funkcja:

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

Ale bezpośrednie wywołanie ClrImmediate() w ten sposób:

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

Działa tylko wtedy, gdy ustawiam breakpoint na Debug.Print, w przeciwnym razie wyczyszczenie zostanie wykonane po wykonaniu ShowCommandBarNames() - nie przed debugowaniem.Print . Niestety, telefon DoEvents() nie pomógł mi... I nie ważne: TRUE lub FALSE jest ustawione dla SendKeys.

Do rozwiązania tego używam kolejnych kilku wywołania:

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

Sub start_ShowCommandBarNames()
   ClrImmediate
   Application.OnTime Now + TimeSerial(0, 0, 1), "ShowCommandBarNames"
End Sub

Wydaje mi się, że za pomocą APLIKACJI.OnTime może być bardzo przydatny w programowaniu dla VBA IDE. W tym przypadku może być używany nawet razy(0, 0, 0).

 1
Author: Leon Rom,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2017-12-05 05:28:34

Zaznaczona odpowiedź nie działa, jeśli zostanie uruchomiona za pomocą przycisku w arkuszu. Otwiera okno dialogowe przejdź do programu excel, ponieważ CTRL + G jest skrótem. Musisz wcześniej ustawić Focus na natychmiastowym oknie. Możesz potrzebować również DoEvent, jeśli chcesz Debug.Print zaraz po oczyszczeniu.

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

Dla kompletności ,jak zauważył @ Austin D:

Dla tych, którzy się zastanawiają, klawisze skrótu to Ctrl + G (aby aktywować Natychmiastowe okno), następnie Ctrl + A (aby zaznaczyć wszystko), następnie Del (aby wyczyścić).

 1
Author: Artur Fityka,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-04-12 12:07:51

Przetestowałem ten kod na podstawie wszystkich komentarzy powyżej. Wygląda na to, że działa bez zarzutu. Komentarze?

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

Poprzednio używałem Debug.Print String(200, chr(10)), który wykorzystuje limit przepełnienia bufora wynoszący 200 linii. Nie podoba mi się ta metoda bardzo, ale to działa.

 -1
Author: user314256,
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2018-10-05 12:56:19