Home |
Search |
Today's Posts |
#11
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
You could do, but remember that you will want to run it from the VB IDE, so
probably best to create a toolbar button, as MZ-Tools does. Here is how to do it First, insert a class module with this code Private WithEvents CbE As CommandBarEvents Private Sub CbE_Click(ByVal CommandBarControl As Object, _ Handled As Boolean, _ CancelDefault As Boolean) Select Case CommandBarControl.Caption Case "Clear Immediate Window": ClearImmediateWindow End Select End Sub Sub AddNewMenuItem() Dim oCB As CommandBar Dim oCbCtl As CommandBarControl Set oCB = Application.VBE.CommandBars("Standard") Set oCbCtl = oCB.Controls.Add(temporary:=True) With oCbCtl .Caption = "Clear Immediate Window" .Style = msoButtonCaption End With Set CbE = Application.VBE.Events.CommandBarEvents(oCbCtl) End Sub and then put this code in a standard module to load the commandbar Public cCbE As clsCbE Sub AddVBECommandbars() Set cCbE = New clsCbE cCbE.AddNewMenuItem End Sub Call AddVBECommandbars from you Workbok_Open -- HTH RP (remove nothere from the email address if mailing direct) "Jim May" wrote in message news:2P9hd.195680$a85.167619@fed1read04... Would one paste this code into their Personal.xls file so that it is always available? TIA, "keepITcool" wrote in message ... "Steven Deng" wrote : Hello, I tried a couple methods posted on the internet, yet to find a working one. If you have something working, can you share? Thank you! Sincerely, Steven Deng et voila! I've adapted Jamie Collins original as found on Dick Kuslieka's Blogs... 1) It searches a bit harder for the immediate pane 2) It can be used in 'NonEnglish' Excel No longer hardcoded for "Immediate" and CtrlA. It does require "Access to the Visual Basic Project" but so does Jamie's original :) Have fun! keepITcool < email : keepitcool chello nl (with @ and .) < homepage: http://members.chello.nl/keepitcool Option Explicit '<--- Excel Version --- ' Code in a standard module 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() 'Adapted by keepITcool 'Original from Jamie Collins fka "OneDayWhen" 'http://www.dicks-blog.com/excel/2004/06/clear_the_immed.html 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 ' Excel2003: Registry Editor (Regedit.exe) ' HKLM\SOFTWARE\Microsoft\Office\11.0\Excel\Security ' Change or add a DWORD called 'AccessVBOM', set to 1 ' Excel2002: Tools/Macro/Security ' Tab 'Trusted Sources', Check 'Trust access..' 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 |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Clear cells automatically | Excel Discussion (Misc queries) | |||
Window Arrange Automatically | Excel Discussion (Misc queries) | |||
Automatically clear values from a range of selected cells | Excel Discussion (Misc queries) | |||
How do I clear data in selected cells automatically | Excel Discussion (Misc queries) | |||
Are there ways to clear the intermediate windows automatically? | Excel Programming |