web-dev-qa-db-fra.com

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

Est-ce que quelqu'un sait comment effacer la fenêtre immédiate en utilisant VBA?

Bien que je puisse toujours le nettoyer moi-même manuellement, je suis curieux de savoir s'il est possible de le faire par programme.

excelvbaexcel-vbaimmediate-window
43
Alpha

Vous trouverez ci-dessous une solution de ici

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
25
Blaz Brencic

Beaucoup plus difficile à faire que j'avais prévu. J'ai trouvé une version ici de keepitcool qui évite le redouté Sendkeys

Exécutez ceci à partir d'un module standard.

_ {Mis à jour car le message initial manquait les déclarations de fonction privée - le travail de copie et de collage médiocre par le vôtre} _

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
23
brettdj

SendKeys est simple, mais vous pouvez ne pas l’aimer (par exemple, il ouvre la fenêtre Immédiate si elle était fermée et déplace le focus).

La méthode WinAPI + VBE est très complexe, mais vous pouvez souhaiter ne pas accorder d’accès VBA à VBE (cela peut même être la politique de votre groupe d’entreprise).

Au lieu de nettoyer, vous pouvez vider son contenu (ou une partie de celui-ci ...) avec des blancs:

Debug.Print String(65535, vbCr)

Malheureusement, cela ne fonctionne que si la position du curseur est à la fin de la fenêtre Immediate (la chaîne est insérée et non ajoutée). Si vous ne publiez que du contenu via Debug.Print et n'utilisez pas la fenêtre de manière interactive, le travail sera fait. Si vous utilisez activement la fenêtre et accédez occasionnellement au contenu, cela ne vous aidera pas beaucoup.

16
Akos Groller

ou même plus simple

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

Voici une combinaison d’idées (testée 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 Immediate (peur de supprimer le code par accident, , De sorte que ce qui précède est un piratage du code que vous avez tous écrit.

Cela résout le problème mentionné ci-dessus par Akos Groller: "Malheureusement, cela ne fonctionne que si la position du curseur est à la fin de La fenêtre Immédiate"

Le code ouvre la fenêtre Immediate (ou le met en évidence), Envoie un CTRL + FIN, suivi d'un flot de nouvelles lignes, Ainsi, le contenu de débogage précédent n'est pas visible.

Veuillez noter que DoEvents est crucial , sinon la logique échouerait (La position du curseur ne se déplacerait pas à la fin de la fenêtre Immediate).

5
El Scripto

J'ai eu le même problème. Voici comment j'ai résolu le problème avec l'aide du lien Microsoft: https://msdn.Microsoft.com/en-us/library/office/gg278655.aspx

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

Après quelques expériences, j'ai créé quelques mods pour le code de mehow comme suit:

  1. Erreurs d'interception (le code d'origine est en train de basculer car il n'a pas été fait référence à "VBE", que j'ai également remplacé par myVBE pour plus de clarté)
  2. Définissez la fenêtre Immédiat sur visible (juste au cas où!)
  3. Commenté la ligne pour retourner le focus à la fenêtre d'origine car c'est cette ligne qui supprime le contenu de la fenêtre de code sur les ordinateurs où des problèmes de minutage se produisent (j'ai vérifié cela avec PowerPoint 2013 x32 sur Windows 7 x64). Il semble que le focus soit en train de revenir avant la fin de SendKeys, même si Wait est défini sur True!
  4. Modifiez l'état d'attente sur SendKeys, car il ne semble pas adhérer à mon environnement de test.

J'ai également noté que le projet doit avoir 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
2
Jamie Garroch

La réponse marquée ne fonctionne pas si elle est déclenchée via un bouton de la feuille de travail. Il ouvre la boîte de dialogue Aller à Excel car CTRL + G est un raccourci pour. Vous devez définirFocus sur la fenêtre immédiate avant. Vous aurez peut-être aussi besoin de DoEvent si vous voulez Debug.Print juste après la suppression.

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

Pour être complet, comme @Austin D l’a remarqué:

Pour ceux qui le demandent, les raccourcis clavier sont Ctrl + G (pour activer la fenêtre Immediate), puis Ctrl + A (pour tout sélectionner), puis Del (pour Le supprimer).

1
Artur Fityka

Pour le nettoyage de la fenêtre immédiate, j'utilise (VBA Excel 2016) 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

ne fonctionne que si je mets le point d'arrêt sur Debug.Print, sinon l'effacement sera effectué après l'exécution de ShowCommandBarNames() - PAS avant Debug.Print . Malheureusement, l'appel de DoEvents() ne m'a pas aidé ... Et peu importe: TRUE ou FALSE est défini pour SendKeys.

Pour résoudre ce problème, j'utilise les 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 ).

1
Leon Rom

Je suis en faveur de ne jamais dépendre des touches de raccourci, car cela peut fonctionner dans certaines langues mais pas toutes ...

Public Sub CLEAR_IMMEDIATE_WINDOW()
'by Fernando Fernandes
'YouTube: Expresso Excel
'Language: Portuguese/Brazil
    Debug.Print VBA.String(200, vbNewLine)
End Sub
1
Fernando Fernandes
Sub ClearImmediateWindow()
    SendKeys "^{g}", False
    DoEvents
    SendKeys "^{Home}", False
      SendKeys "^+{End}", False
      SendKeys "{Del}", False
        SendKeys "{F7}", False
End Sub
1
Mike Rodriguez