View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Chip Pearson Chip Pearson is offline
external usenet poster
 
Posts: 7,247
Default In need of advice?

Jamie,

I can't get the code to work. It will activate the Immediate
window, but won't clear it. I tested in 97, 2002, and 2003.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com



"Jamie Collins" wrote in message
om...
onedaywhen wrote ...

I have discovered a truly remarkable way of
programmatically clearing the Immediate
Window (without using SendKeys) which
this margin is too small to contain.


I couldn't let this one go (Fermat parody, right?), the offer

of a
Chip Pearson autographed bottle of home-brewed hot sauce

proving just
too irresistible:


http://www.google.com/groups?threadm...%40tkmsftngp04

I've some up with the code, Excel and VB6 versions (the latter

being
VB6 code to clear the Excel Immediate Window but can be easily
modified to clear the VB6 immediate window). How may I claim my

prize?

'<--- Excel Version ---
' Code in a standard module
Option Explicit

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_ACTIVATE As Long = &H6
Private Const WM_KEYDOWN As Long = &H100
Private Const VK_CONTROL As Long = &H11
Private Const KEYSTATE_KEYDOWN As Long = &H80

Private m_KeyboardState(0 To 255) As Byte
Private m_hSaveKeystate As Long

Sub ClearImmediateWindow()

Dim hChild As Long
Dim hParent As Long
Dim strCaptionVbe As String

Const CLASS_VBE As String = "wndclass_desked_gsk"
Const CLASS_IMMEDIATE As String = "VbaWindow"
Const CAPTION_IMMEDIATE As String = "Immediate"

' Get handle to Immediate Window
strCaptionVbe = Excel.Application.VBE.MainWindow.Caption
hParent = FindWindow(CLASS_VBE, strCaptionVbe)
hChild = FindWindowEx(hParent, ByVal 0&, _
CLASS_IMMEDIATE, CAPTION_IMMEDIATE)

If hChild = 0 Then
MsgBox "Immediate Window not found."
Exit Sub
End If

' Activate Immediate Window
PostMessage hChild, WM_ACTIVATE, 1, 0&

' Simulate depressing of CTRL key
GetKeyboardState m_KeyboardState(0)
m_hSaveKeystate = m_KeyboardState(VK_CONTROL)
m_KeyboardState(VK_CONTROL) = KEYSTATE_KEYDOWN
SetKeyboardState m_KeyboardState(0)
DoEvents

' Send CTRL+A (select all) and Delete keystokes
PostMessage hChild, WM_KEYDOWN, vbKeyA, 0&
PostMessage hChild, WM_KEYDOWN, vbKeyDelete, 0&

' Schedule cleanup code to run
Application.OnTime Now + TimeSerial(0, 0, 0), "DoCleanUp"

End Sub

Sub DoCleanUp()

' Restore keyboard state
GetKeyboardState m_KeyboardState(0)
m_KeyboardState(VK_CONTROL) = m_hSaveKeystate
SetKeyboardState m_KeyboardState(0)

End Sub
'</--- Excel Version ---

'<--- VB6 Version ---
Option Explicit

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 GetWindowThreadProcessId _
Lib "user32" (ByVal hwnd As Long, _
lpdwProcessId As Long) As Long
Private Declare Function GetCurrentThreadId _
Lib "kernel32" () As Long
Private Declare Function AttachThreadInput _
Lib "user32" (ByVal idAttach As Long, _
ByVal idAttachTo As Long, _
ByVal fAttach As Long) 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_ACTIVATE As Long = &H6
Private Const WM_KEYDOWN As Long = &H100
Private Const VK_CONTROL As Long = &H11
Private Const KEYSTATE_KEYDOWN As Long = &H80
Private Sub Form_Load()

Dim xlApp As Object
Dim hChild As Long
Dim KeyboardState(0 To 255) As Byte
Dim hParent As Long
Dim hProcessID As Long
Dim hThreadID As Long
Dim hCurrentThreadID As Long
Dim hSaveKeystate As Long
Dim hRet As Long
Dim strCaptionVbe As String

Const CLASS_VBE As String = "wndclass_desked_gsk"
Const CLASS_IMMEDIATE As String = "VbaWindow"
Const CAPTION_IMMEDIATE As String = "Immediate"

' Get running instance of Excel
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
On Error GoTo 0

If xlApp Is Nothing Then
MsgBox "Excel not running."
Exit Sub
End If

' Get handle to Immediate Window
On Error Resume Next
strCaptionVbe = xlApp.VBE.MainWindow.Caption
On Error GoTo 0

hParent = FindWindow(CLASS_VBE, strCaptionVbe)
hChild = FindWindowEx(hParent, ByVal 0&, CLASS_IMMEDIATE,
CAPTION_IMMEDIATE)

If hChild = 0 Then
MsgBox "Immediate Window not found."
Exit Sub
End If

' Activate Immediate Window
PostMessage hChild, WM_ACTIVATE, 1, 0&

' Get thread info
hThreadID = GetWindowThreadProcessId(hChild, vbNull)
hCurrentThreadID = GetCurrentThreadId()

' Attach Excel thread
hRet = AttachThreadInput(hThreadID, hCurrentThreadID, 1)

' Simulate depressing of CTRL key
GetKeyboardState KeyboardState(0)
hSaveKeystate = KeyboardState(VK_CONTROL)
KeyboardState(VK_CONTROL) = KEYSTATE_KEYDOWN
SetKeyboardState KeyboardState(0)
DoEvents

' Send CTRL+A (select all) and Delete keystokes
PostMessage hChild, WM_KEYDOWN, vbKeyA, 0&
PostMessage hChild, WM_KEYDOWN, vbKeyDelete, 0&

' Restore keyboard state
GetKeyboardState KeyboardState(0)
KeyboardState(VK_CONTROL) = hSaveKeystate
SetKeyboardState KeyboardState(0)

' Re-attched thread
hRet = AttachThreadInput(hThreadID, hCurrentThreadID, 0)

End Sub
'</--- VB6 Version ---

Jamie

--