Posted to microsoft.public.excel.programming
|
|
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
--
|