Используйте VBA для очистки немедленного окна?

кто-нибудь знает, как очистить окно immediate с помощью VBA?

хотя я всегда могу очистить его вручную, мне интересно, есть ли способ сделать это программно.

12 ответов


Ниже приведено решение из здесь

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.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 является прямым, но вам может не понравиться (например, он открывает немедленное окно, если оно было закрыто, и перемещает фокус).

способ WinAPI + VBE действительно сложный, но вы можете не предоставлять VBA доступ к VBE (возможно, даже ваша групповая политика компании не будет).

вместо очистки вы можете очистить его содержимое (или часть его...) С холостыми:

Debug.Print String(65535, vbCr)

к сожалению, это работает только в том случае, если позиция курсора находится в конце непосредственного окна (строка вставляется, а не добавляется). Если вы публикуете контент только через Debug.Печать и не используйте окно в интерактивном режиме, это сделает работу. Если вы активно используете окно и иногда переходите к содержимому, это не очень помогает.


или еще проще

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

вот комбинация идей (протестирована с 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

мне не нравится удалять немедленный контент (боязнь случайно удалить код, Итак, вышеизложенное-это взлом некоторого кода, который вы все написали.

Это обрабатывает проблему, о которой пишет Akos Groller выше: "к сожалению, это работает только если позиция каре в конце of этот Немедленное окно"

код открывает окно Immediate (или помещает на него фокус), отправляет CTRL+END, за которым следует поток новых строк, таким образом, предыдущего содержимого отладки не видно.

Пожалуйста, обратите внимание, что DoEvents имеет решающее значение, иначе логики не будет (позиция курсора не будет перемещаться во времени до конца непосредственного окна).


после некоторых экспериментов я сделал несколько модов для кода mehow следующим образом:

  1. ошибки Trap (исходный код падает из-за не установки ссылки на "VBE", которую я также изменил на myVBE для ясности)
  2. установите немедленное окно видимым (на всякий случай!)
  3. прокомментировал строку, чтобы вернуть фокус в исходное окно, поскольку именно эта строка вызывает удаление содержимого окна кода на машинах, где возникают проблемы с синхронизацией (I проверено это с помощью PowerPoint 2013 x32 на Win 7 x64). Кажется, фокус переключается обратно до завершения SendKeys, даже если Wait установлен в True!
  4. измените состояние ожидания на SendKeys, поскольку оно, похоже, не соблюдается в моей тестовой среде.

Я также отметил, что проект должен иметь доверие для включенной объектной модели проекта 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

У меня была та же проблема. Вот как я решил проблему с помощью ссылки Microsoft:https://msdn.microsoft.com/en-us/library/office/gg278655.aspx

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

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) следующая функция:

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() - не перед "отладка".Печать. К сожалению, call of DoEvents() не помогло мне... И неважно:правда или FALSE - это набор для sendkeys будет.

чтобы решить эту проблему, я использую следующие несколько вызовов:

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

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

мне кажется, что с помощью приложение.OnTime может быть очень полезно при программировании для VBA IDE. В этом случае его можно использовать даже TimeSerial(0, 0, 0).


отмеченный ответ не работает, если срабатывает с помощью кнопки на листе. Он открывает диалоговое окно перейти в excel, так как CTRL+G является ярлыком. Вы должны установить фокус на Immediate Window раньше. Вам может понадобиться также DoEvent Если вы хотите Debug.Print сразу после клиринга.

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

для полноты, как заметил @ Austin D:

для тех, кто интересуется, сочетания клавиш Ctrl+G (для активации Немедленное окно), затем Ctrl+A (чтобы выбрать все), затем Del (чтобы четкий он.)


я протестировал этот код на основе всех комментариев выше. Кажется, работает безупречно. Комментарии?

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

ранее использовали Debug.Print String(200, chr(10)) который использует преимущество предела переполнения буфера 200 строк. Не нравится этот метод, но он работает.