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

Кто-нибудь знает, как очистить ближайшее окно с помощью VBA?

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

Ответ 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

Ответ 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 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

Ответ 3

SendKeys прямо, но вам может не понравиться (например, он открывает окно Immediate, если он был закрыт, и перемещает фокус).

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

Вместо очистки вы можете очистить свой контент (или его часть...) пробелами:

Debug.Print String(65535, vbCr)

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

Ответ 4

или даже более простой

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

Ответ 5

Вот комбинация идей (протестированных с помощью 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 (страх удалить код случайно, поэтому выше это взломать код, который вы все написали.

Это устраняет проблему, о которой пишет Акос Грослер: "К сожалению, это работает только в том случае, если позиция каретки находится в конце окно" Немедленное"

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

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

Ответ 6

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

Ошибки ловушки (исходный код падает из-за отсутствия ссылки на "VBE", который я также изменил для myVBE для ясности).
Установите окно Immediate на видимое (на всякий случай!)
Отметьте строку, чтобы вернуть фокус в исходное окно, так как это строка, которая вызывает удаление содержимого окна кода на машинах, где возникают проблемы синхронизации (я проверил это с помощью PowerPoint 2013 x32 на Win 7 x64). Кажется, что основное внимание уделяется переключению, прежде чем SendKeys завершит работу, даже если Wait установлен на True!
Измените состояние ожидания на 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 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

Ответ 7

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

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

Ответ 8

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

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

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

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

Ответ 9

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

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

Ответ 10

Для очистки окна Immediate я использую следующую функцию (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() - NOT перед 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).

Ответ 11

Sub ClearImmediateWindow()
    SendKeys "^{g}", False
    DoEvents
    SendKeys "^{Home}", False
      SendKeys "^+{End}", False
      SendKeys "{Del}", False
        SendKeys "{F7}", False
End Sub

Ответ 12

Понятия взяты из других ответов, но эта комбинация отсутствует и, кажется, работает лучше для меня:

Sub ClearImmediateWindow()
    Dim i As Long

    Application.SendKeys "^g ^{HOME}"
    DoEvents

    For i = 1 To 60
        Debug.Print ""
    Next
End Sub

Ответ 13

Только что проверил в Excel 2016, и этот кусок кода работал для меня:

Sub ImmediateClear()
   Application.VBE.Windows("Immediate").SetFocus
   Application.SendKeys "^{END} ^+{HOME}{DEL}"
End Sub

Ответ 14

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

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 строк. Не понравился этот метод много, но он работает.