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 |
Partager