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.
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
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
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.
ou même plus simple
Sub clearDebugConsole()
For i = 0 To 100
Debug.Print ""
Next i
End Sub
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).
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
Après quelques expériences, j'ai créé quelques mods pour le code de mehow comme suit:
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
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).
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 ).
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
Sub ClearImmediateWindow()
SendKeys "^{g}", False
DoEvents
SendKeys "^{Home}", False
SendKeys "^+{End}", False
SendKeys "{Del}", False
SendKeys "{F7}", False
End Sub