XL 2019 Effacer la fenêtre debug.print via VBA

[Naaave]

Bonjour,

J'utilise souvent la fenêtre debug pour afficher des valeurs quand je développe
Je la vide à la main en faisant un ctrl + a et supprimer mais ça demande une action et quand je suis en plein débug et que je test mes macros a répétitions, j'aimerai pouvoir avoir une subroutine que je peux placer en début de la macro que je suis en train de développer et que ça supprime tout ce qu'il y avait dans le debug précédent le lancement de cette macro. C'est purement du confort mais on peut faire tellement de trucs avec Excel, j'ai du mal à croire que c'est pas possible

Avec le code suivant qui fonctionne ça efface bien, sauf quand je l'éxécute en début de ma macro Ecrire(), ça efface la fenêtre précédente mais aussi celle en cours
Avez vous une idée qui permettait de réaliser ce que je souhaite ?

Sub Ecrire()
    Efface
    Dim i As Integer
    For i = 1 To 50
        Debug.Print i
    Next i
End Sub

Sub Efface()
    Application.SendKeys "^g", True
    Application.SendKeys "^a", True
    Application.SendKeys "{DEL}", True
End Sub

 

[Dudu2]

Bonjour,

ça efface la fenêtre précédente mais aussi celle en cours

Pas compris ce qu'est le fenêtre précédente et celle en cours.

Sinon, forcer le positionnement sur le VBA:

Sub Efface()
    Application.SendKeys "%{F11}^g^a{DEL}", True
    DoEvents
End Sub

 

[Dudu2]

Non, ça n'efface rien de rien.

 

[Naaave]

Si j'exécute la macro sans mettre la Sub Efface, ça affiche les nombres de 1 à 50 dans le debug.print
Si j'exécute la Sub Efface seule ensuite, ça efface bien la fenêtre "Exécution" du débug.print

Ce que j'aimerais c'est qu'en réalisant les Sub Efface et ensuite Ecrire, ça efface ce qui avait été inscrit précédemment dans la fenêtre d'exécution du debug.print et ensuite écrire ce que ma Sub Ecrire est censé faire
Sauf que si j'éxécute les 2 à la suite, ça efface tout ce qui a été écrit avant mais aussi ce qui est écrit après

Essayez en exécutant la macro Ecrire qui contient aussi le Efface
(C'est pas évident à expliquer )

 

[Naaave]

J'exécute ça :

Résultat : Les nombres de 1 à 50 dans la fenêtre d'exécution

J'éxécute la macro Efface

Résultat ça efface bien tout

J'exécute les 2 macros en effaçant d'abord et en écrivant ensuite

Résultat, ça commence à afficher et efface directement

J'aimerais effacer ma fenêtre dans un premier temps puis écrire ce que je veux ensuite mais que ça reste pour que je puisse débuguer mon code aisement

 

[Dudu2]

Sauf que si j'éxécute les 2 à la suite, ça efface tout ce qui a été écrit avant mais aussi ce qui est écrit après

Soit:

Sub Ecrire()
    Efface
    Debug.Print "aaa"
End Sub

Sub Efface()
    Application.SendKeys "%{F11}", True
    Application.SendKeys "^g", True
    Application.SendKeys "^a", True
    Application.SendKeys "{DEL}", True
End Sub

Et ça efface APRÉS le Debug.Print, donc on a rien.

Soit:

Sub Ecrire()
    Efface
    Debug.Print "aaa"
End Sub

Sub Efface()
    Application.SendKeys "%{F11}", True
    Application.SendKeys "^g", True
    Application.SendKeys "^a", True
    Application.SendKeys "{DEL}", True
    DoEvents
End Sub

Et ça N'efface PAS.

 

[Dudu2]

Ça ça marche mais c'est un peu "tiré par les cheveux":

Sub Ecrire()
    Application.OnTime Now + TimeSerial(0, 0, 1), "Suite"
    Efface
    'Debug.Print "aaa"
End Sub

Sub Suite()
    Debug.Print "aaa"
End Sub

Sub Efface()
    CreateObject("wscript.shell").SendKeys "%{F11}^g^a{DEL}"
End Sub

 

[Dudu2]

J'ai tout essayé ce que je connais et je n'y arrive pas.
Il faut soit que tu exécutes Efface() indépendamment de toute macro (c'est quand même plus rapide que d'y aller à la mano), soit que tu exécutes la suite de manière asynchrone comme ci-dessus ce qui revient au même d'un point de vue exécution.

Utilise plutôt des:

CreateObject("wscript.shell").SendKeys "%{F11}^g^a{DEL}"

pour ne pas affecter le NUMLOCK.

 

[kiki29]

Salut, pour info, dégoté sur un site US, à tester

Option Explicit

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()
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
    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

 

[Naaave]

C'est fou qu'il n'y ait pas de manière simple de faire ça quand même
Merci à vous, je vais tester tout ça !

 

[Dudu2]

Le code de @kiki29, ça marche pas, même en adaptant.

J'ai essayé avec des keybd_event et autres mais c'est pareil que les SendKeys.

Le problème reste qu'il faut un DoEvents pour attendre que les touches envoyées soient traitées. Sinon le Debug.Print d'Ecrire() arrive avant le traitement des touches et il disparait.
Mais ce même DoEvents rend inopérant le {DEL}. Et ça, je ne comprends pas pourquoi.

Sub Efface()
    Const ImmediateWindowName = "Exécution"
    
    Application.VBE.Windows(ImmediateWindowName).SetFocus
    CreateObject("wscript.shell").SendKeys "^a{DEL}"
    'DoEvents
End Sub