Utiliser VBA pour effacer la fenêtre immédiate?

beaucoup plus difficile à faire que je l'avais envisagé. J'ai trouvé une version ici par keepitcool qui évite le redouté Sendkeys

exécutez ceci à partir d'un module régulier.

mise à Jour en tant que post initial raté le Privé, les Déclarations de Fonction pauvres copiez et collez travail par votre serviteur

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 est droit, mais vous pouvez ne pas l'aimer (par exemple, il ouvre la fenêtre immédiate s'il était fermé, et déplace la mise au point).

La Voie WinAPI + VBE est vraiment élaborée, mais vous pouvez ne pas accorder à VBA l'accès à VBE (pourrait même être votre politique de groupe d'entreprise de ne pas le faire).

au lieu de nettoyer, vous pouvez vider son contenu (ou en partie...) loin avec des blancs:

Debug.Print String(65535, vbCr)

malheureusement, cela ne fonctionne que si la position caret est à la fin de la fenêtre immédiate (la chaîne est insérée, pas ajoutée). Si vous ne postez du contenu que via Debug.Imprimez et n'utilisez pas la fenêtre de façon interactive, cela fera l'affaire. Si vous utilisez activement la fenêtre et, occasionnellement, de naviguer dans le contenu, cela n'aide pas beaucoup.

ou encore plus simple

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

Voici une combinaison d'idées (testé avec excel VBA 2007):

' * (cela peut remplacer votre appel quotidien au débogage)

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

Je n'aime pas supprimer le contenu immédiat (peur de supprimer le code par accident, donc ce qui précède est un piratage d'une partie du code que vous avez tous écrit.

ceci gère le problème sur lequel Akos Groller écrit ci-dessus: "Malheureusement, cela ne fonctionne que si la position caret est à la fin de le Fenêtre"

le code ouvre la fenêtre immédiate (ou met l'accent sur elle), envoie une fin CTRL+, suivie d'un flot de nouvelles lignes, ainsi, le contenu de débogage précédent n'est pas en vue.

Veuillez noter que la fonction DoEvents est crucial, sinon la logique échouerait (la position caret ne se déplacerait pas dans le temps jusqu'à la fin de la fenêtre immédiate).

après quelques expériences, j'ai fait quelques modifications au code de méhow comme suit:

1. intercepter les erreurs (le code d'origine est de tomber en raison de ne pas fixer une référence à "VBE", que j'ai également changé de myVBE pour plus de clarté)
2. Réglez la fenêtre immédiate à visible (juste au cas où!)
3. a commenté la ligne pour retourner le focus à la fenêtre d'origine car c'est cette ligne qui provoque la suppression du contenu de la fenêtre de code sur les machines où des problèmes de timing se produisent (I vérifié avec PowerPoint 2013 x32 sur Win 7 x64). Il semble que le focus revienne avant que SendKeys ne soit terminé, même avec Wait mis à True!
4. Changer l'état d'attente sur SendKeys comme il ne semble pas être respectées sur mon environnement de test.

j'ai également noté que le projet doit avoir la confiance pour le modèle d'objet de projet VBA activé.

' 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

j'ai eu le même problème. Voici comment j'ai résolu le problème avec l'aide de Microsoft lien: 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

je suis en faveur de ne jamais dépendre des touches de raccourci, car cela peut fonctionner dans certaines langues mais pas toutes... Voici mon humble contribution:

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

pour le nettoyage Immédiat fenêtre j'utilise VBA (Excel 2016) de la fonction suivante:

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

mais appel direct de ClrImmediate() comme ceci:

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

fonctionne seulement si je mets le point de rupture sur Debug.Print, sinon, la compensation sera effectuée après l'exécution de ShowCommandBarNames() - pas avant Debug.Imprimer. Malheureusement, appel de DoEvents() ne m'aide pas... Et peu importe: TRUE ou FALSE est défini pour SendKeys.

Pour résoudre cela, j'utilise deux prochains appels:

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

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

Il me semble que l'utilisation de Application.OnTime pourrait être très utile dans la programmation pour VBA IDE. Dans ce cas, il peut être utilisé même TimeSerial(0, 0, 0).

la réponse marquée ne fonctionne pas si elle est déclenchée par un bouton dans la feuille de travail. La boîte de dialogue Go to excel s'ouvre car CTRL+G est un raccourci. Vous devez vous concentrer sur la fenêtre immédiate avant. Vous devrez également DoEvent si vous voulez Debug.Print juste après le dégagement.

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

Pour l'exhaustivité, comme @Austin D remarqué:

pour ceux qui se demandent, les touches de raccourci sont Ctrl+G (pour activer le Fenêtre immédiate), puis Ctrl+A (Pour Tout sélectionner), puis Del (pour clair il.)

j'ai testé ce code sur la base de tous les commentaires ci-dessus. Semble fonctionner parfaitement. Des commentaires?

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

utilisé précédemment le Debug.Print String(200, chr(10)) qui tire avantage de la limite de dépassement de tampon de 200 lignes. Je n'ai pas beaucoup aimé cette méthode mais elle fonctionne.