Clear la fenêtre Exécution

Version imprimable

19/03/2013, 13h15
MarcelG

Clear la fenêtre Exécution

Bonjour la Forum,

Pour le contrôle de mes procédures, j'utilise souvent la méthode

Code:

Debug.Print lavariable

Question :

Comment coder pour la fenêtre Exécution
1 - son ouverture si elle n'est pas ouverte
2 - son effacement
3 - sa fermeture

J'ai cherché en utilisant

ce lien

sans succès

Merci par avance, et bonne journée à tous.

Bonjour,

Regarde avec ceci mais SendKeys n'est pas top :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub FenetreExecution()
 
    With Application.VBE.ActiveWindow.Collection("Exécution")'depuis le VBE
 
        .Visible = True 'affiche
 
        .SetFocus 'donne le focus
 
        SendKeys "^(A)" 'sélectionne tout le texte présent dans la fenêtre (quand ça veut marcher :o(( )
 
        SendKeys "{DELETE}" 'le supprime
 
        .Close 'ferme la fenêtre
 
    End With
 
End Sub

Hervé.

19/03/2013, 18h14
MarcelG

Clear Exécution

Bonsoir Theze,

(Heureux de te retrouver.)

OK pour tout le code sauf pour le SendKeys qui ne fonctionne pas.

Sur le web, (à moins que j'aie mal cherché), je n'ai pas trouvé l'API Windows correspondant.

Merci à toi.

Un début de réponse.

(D'après Frédéric Sigonneau)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ClearDebugWindow()
'Bill Manville, mpep
  Dim i As Integer
  ' put in some test data
  For i = 1 To 10
    Debug.Print "test"
  Next
 
'Marcel : afin de voir le contenu de la fenêtre  
Application.wait Now + TimeValue("00:00:05")
 
  ' go to VB editor
  Application.CommandBars.FindControl(ID:=1695).Execute
  ' ensure debug window is displayed and active
  Application.VBE.CommandBars.FindControl(ID:=2554).Execute
  SendKeys "^{HOME}+^{END}{DEL}"
End Sub

Cela étant, l'idéal serait, à mon avis, de se débarraser des SenKeys.

19/03/2013, 18h47
mercatog

Simplement avec SendKeys

Code:

SendKeys "^g ^a {DEL}"
19/03/2013, 18h55
MarcelG

CLEAR EXECUTION

Bonsoir mercatog,

(ravi de te retrouver)

SendKeys inefficaces sur mon poste.

Apparemment, je ne suis pas le seul en ce cas.

API Windows??

(je dois partir jusqu'à lundi)

Bonsoir Marcel

Citation:

API Windows??

Code trouvé sur le net tel

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
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 TmpState(0 To 255) As Byte
Dim lPane As Long
 
lPane = GetImmHandle
If lPane = 0 Then MsgBox "Immediate Window not found."
If lPane < 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 lPane, WM_KEYDOWN, vbKeyEnd, 0&
'Sink the SHIFT
TmpState(vbKeyShift) = KEYSTATE_KEYDOWN
SetKeyboardState TmpState(0)
'Send CTRLSHIFT+Home and CTRLSHIFT+BackSpace
PostMessage lPane, WM_KEYDOWN, vbKeyHome, 0&
PostMessage lPane, 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
 
 
'This function finds the Immediate Pane and returns a handle.
'Docked or MDI, Desked or Floating, Visible or Hidden
Function GetImmHandle() As Long
Dim oWnd As Object, bDock As Boolean, bShow As Boolean
Dim sMain As String, sDock As String, sPane As String
Dim lMain As Long, lDock As Long, lPane As Long
 
 
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
On Error GoTo 0
 
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 oWnd
 
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

Lance ClearImmediateWindow

Bonsoir,

Ceci fonctionne assez bien chez moi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub FenetreExecution()
 
    With Application.VBE.MainWindow.Collection("Exécution")
 
        .Visible = True 'affiche
 
        .SetFocus 'donne le focus
 
        Application.VBE.CommandBars.FindControl(, 756).Execute 'sélectionne tout
 
        SendKeys "{DELETE}" 'supprime
 
      .Close 'ferme la fenêtre
 
    End With
 
End Sub

Hervé.

Bonjour à tous,

Une piste d'après Mokurin

ATTENTION : ne pas lancer la procédure à partir d'Excel mais exclusivement dans le VBE

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
'###################################################################################
'### D'aprés l'article de Mokurin (February 14, 2006 at 5:32 am). Voir le lien   ###
'### http://dailydoseofexcel.com/archives/2004/06/09/clear-the-immediate-window/ ###
'###################################################################################
 
Declare Function SendInput& Lib "user32.dll" ( _
  ByVal nInputs As Long, pInputs As INPUT_TYPE, ByVal cbSize As Long)
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
  Destination As Any, Source As Any, ByVal Length As Long)
 
Type INPUT_TYPE
  dwType As Long
  xi(0 To 23) As Byte
End Type
Type KEYBDINPUT
  wVk As Integer
  wScan As Integer
  dwFlags As Long
  time As Long
  dwExtraInfo As Long
End Type
 
Const INPUT_KEYBOARD = 1
Const KEYEVENTF_KEYUP = &H2
Const VK_CONTROL = &H11
 
Sub ClearFenetreExecution()
Dim inputevents(0 To 7) As INPUT_TYPE
Dim keyevent As KEYBDINPUT
Dim myArray As Variant
Dim n As Integer
'--- Set key name to send ---
myArray = Array(VK_CONTROL, vbKeyG, vbKeyA, vbKeyDelete)
 
For n = 0 To UBound(myArray)
  keyevent.wVk = myArray(n) 'key name
  keyevent.wScan = 0
  keyevent.dwFlags = 0      '0 means press the key down
  keyevent.time = 0
  keyevent.dwExtraInfo = 0
  inputevents(n).dwType = INPUT_KEYBOARD
  CopyMemory inputevents(n).xi(0), keyevent, Len(keyevent)
Next n
 
For n = 0 To UBound(myArray)
  keyevent.wVk = myArray(n)
  keyevent.wScan = 0
  keyevent.dwFlags = KEYEVENTF_KEYUP    'release the key
  keyevent.time = 0
  keyevent.dwExtraInfo = 0
  inputevents(n + UBound(myArray) + 1).dwType = INPUT_KEYBOARD
  CopyMemory inputevents(n + UBound(myArray) + 1).xi(0), keyevent, Len(keyevent)
Next
 
'--- place the events into the stream ---
SendInput n + UBound(myArray) + 1, inputevents(0), Len(inputevents(0))
End Sub

Clear exécution - Précision

Bonsoir le Forum,

Merci à tous pour vos réponses.

Le code de merrcatog est bien effectif.

Je dois y ajouter ceci pour informer puis activer la fenêtre Exécution
Code:

1 2 3 4 5 6 7 8 9 10 11 Dim i As Byte For i = 1 To 5 Debug.Print "le grand mercatog du seigneur des anneaux" Next i Dim fen_exéc As Object Set fen_exéc = Application.VBE.ActiveWindow.Collection("Exécution") With fen_exéc .Visible = True 'affiche .SetFocus 'donne le focus End With
Et si je souhaite fermer cette fenêtre, alors
Code:

1 2 fen_exéc.Close Set fen_exéc = Nothing
Merci encore

20/03/2013, 17h47
MarcelG

Le code de PMO2017

Bonsoir PMO2017,

Après celui de mercatog (voir mon post précédent), j'ai tenté l'activation de ton code.
Celui-ci est aussi effectif (avec le même ajout)

Merci à toi.

Effacement de la fenêtre exécution

Voici un code qui fonctionne chez moi

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub efface_fenetre_execution()
' efface la fenêtre exécution
 
 
' ouvre la fenêtre
Application.VBE.Windows("Exécution").Visible = True
 
' écrit un message
Debug.Print "essai"
 
' efface la fenêtre
With Application.VBE.Windows("Exécution")
    .Visible = True
    .SetFocus
End With
SendKeys "^g ^a {DEL}"
 
'ferme la fenêtre
Application.VBE.Windows("Exécution").Close
 
 
End Sub

01/04/2020, 16h40
MarcelG

Bonjour au Forum,

Bonjour hdhonte et bienvenu sur le Forum,

Code testé
Parfaitement effectif.

Un grand merci à toi. :plusser:
01/04/2020, 19h54
hdhonte

Une précision
Bonsoir,

Dans le code que j'ai envoyé précédemment, l'instruction SendKeys "^g ^a {DEL}" bascule le verrouillage numérique (pourquoi ? mystère)
Il faut donc ajouter une instruction SendKeys "{NUMLOCK}".
Ce qui donne au final :
Code:

1 2 3 4 5 6 7 Sub efface_fenetre_execution() Application.VBE.Windows("Exécution").Visible = True SendKeys "^g ^a {DEL}" SendKeys "{NUMLOCK}" End Sub
Bonne soirée à toutes et à tous

Hubert Dhonte

Salut Hubert,

Sur mon poste de travail, les touches numériques sont parfois désactivées, parfois toujours activées.

J'ai trouvé cela sur la toile
Code:

1 2 3 4 5 6 Private Declare Function GetKeyState Lib "user32" _ (ByVal nVirtKey As Long) As Integer If GetKeyState(vbKeyNumlock) = 0 Then SendKeys "{NUMLOCK}" 'Simule l'appui sur la touche "VERR.NUM" End If
La fonction retourne 1 si les touches sont activées, 0 dans le cas contraire.

Reste à connaître tous les paramètres vbKey possibles. Voir cet espace
Liste possible des vbKey

Super.

(Juste une indication, pense à baliser ton code avec # pour plus de clarté)

Hé, au plaisir Hubert! :D

Bonjour.
J'ai bien aimé l'idée d'afficher dans la fenêtre d'exécution les "Debug.Print", car dans certains cas, par exemple une application qui doit charger des fichiers lourds, ou exécuter des tâches un peu longues, c'est plus lisible que la barre de message en bas à gauche que personne ne lit, et peux remplacer efficacement et simplement un "UserForm".
D'où le code proposé ici (WindowExecute), qui affiche la fenêtre d'exécution (les dimensions sont personnalisables), puis la referme.
Je n'utilise pas d'API ni de "SendKeys" pour rester compatible avec tous.

le code d'appel qui est un exemple non significatif ici :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
'---------------------------------------------------------------------------------------
Sub Test()
'---------------------------------------------------------------------------------------
Dim i As Byte
 
' Ouvre la fenêtre d'éxécution:
Call WindowExecute(WindowShow, True)
 
' Affiche les messages d'exemple:
For i = 1 To 10
    Debug.Print "étape " & i: Application.Wait Now + TimeValue("0:00:01")
Next i
Debug.Print "Fin": Application.Wait Now + TimeValue("0:00:02")
 
' ferme la fenêtre d'éxécution:
Call WindowExecute(WindowClose, False)
 
End Sub

Et le code de la fonction WindowExecute :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Option Explicit
 
'---------------------------------------------------------------------------------------
Type WindowVBE
    Top As Long
    Left As Long
    Height As Long
    Width As Long
End Type
 
Public Enum EnumWindowState
    WindowShow = 1
    WindowClose = 0
End Enum
'---------------------------------------------------------------------------------------
 
'---------------------------------------------------------------------------------------
Sub WindowExecute(WindowState As EnumWindowState, wClear As Boolean, _
                  Optional WTop As Long = 10, Optional WLeft As Long = 10, _
                  Optional wHeight As Long = 300, Optional wWidth As Long = 600)
'---------------------------------------------------------------------------------------
Dim i As Integer
Static Wmain As WindowVBE
 
' Ouvre la fenêtre du VBE:
ThisWorkbook.VBProject.VBE.mainWindow.Visible = True
' Ouvre la fenêtre Exécution:
ThisWorkbook.VBProject.VBE.Windows("Exécution").Visible = True
ThisWorkbook.VBProject.VBE.Windows("Exécution").SetFocus
 
' S'il faut effacer la fenêtre:
If wClear = True Then
    For i = 0 To wHeight / 10: Debug.Print "": Next i 'SendKeys "^g ^a {DELETE}"
End If
 
Select Case WindowState
 
Case WindowShow
 
        ' Mémorise la fenêtre principale:
        With ThisWorkbook.VBProject.VBE.mainWindow
            Wmain.Top = .Top
            Wmain.Left = .Left
            Wmain.Height = .Height
            Wmain.Width = .Width
        End With
 
        ' Détache la fenêtre d'éxécution si elle est liée:
        For i = 1 To ThisWorkbook.VBProject.VBE.mainWindow.LinkedWindows.Count
            If ThisWorkbook.VBProject.VBE.mainWindow.LinkedWindows.Item(i).Caption = "Exécution" Then
                ThisWorkbook.VBProject.VBE.mainWindow.LinkedWindows.Remove ThisWorkbook.VBProject.VBE.mainWindow.LinkedWindows.Item(i)
                Exit For
            End If
        Next i
 
        ' Délace la fenêtre principale:
        With ThisWorkbook.VBProject.VBE.mainWindow
            .Top = WTop
            .Left = WLeft
            .Height = wHeight
            .Width = wWidth
        End With
 
        ' Et met la fenêtre d'éxécution à la même place:
        With ThisWorkbook.VBProject.VBE.Windows("Exécution")
            .Top = WLeft
            .Left = WTop
            .Height = wHeight
            .Width = wWidth
        End With
 
Case WindowClose
 
    ' Lie la fenêtre exécution:
    ThisWorkbook.VBProject.VBE.mainWindow.LinkedWindows.Add ThisWorkbook.VBProject.VBE.Windows("Exécution")
 
    ' Restaure la fenêtre principale:
    With ThisWorkbook.VBProject.VBE.mainWindow
        .Top = Wmain.Top
        .Left = Wmain.Left
        .Height = Wmain.Height
        .Width = Wmain.Width
    End With
 
    ' Ferme la fenêtre du VBE:
    ThisWorkbook.VBProject.VBE.mainWindow.Visible = False
 
End Select
 
End Sub

Peut-être que cela peut donner des idées à certains d'entre vous.
Cordialement.