Clearing the Clipboard task pane in XL ( XP ) !!!

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Via the User Interface you achieve this by simply displaying the Office
ClipBoard and clicking on the 'ClearAll' button .

Programatically , I just can't seem to find a way to do it !!!

In previous versions, you could get the 'ClearAll' button ID and run its
Execute Method , but that doesn't seem to work with XL2002 on XP.

I have also tried some Clipboard related API functions but with no luck ! :(

Any help would be much appreciated >

Jaafar.

Regards.
 
I didn't know Michel Pierron's solution..
but I will look into it :)


in the meantime i've done some work as well...
and it seems to work rather nicely.


Option Explicit
Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&

Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias _
"PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

'creates a long variable out of two words
Private Function MakeLong(ByVal nLoWord As Integer, ByVal nHiWord As
Integer) As Long
MakeLong = nHiWord * 65536 + nLoWord
End Function


Sub ClearOfficeClipboard()
Dim hMain&, hExcel2&, hClip&, hWindow&, hParent&
Dim lParameter&
Dim sTask$

'Author: keepITcool
'Note : betatested in xlXP and xl2003

'Get the caption of the taskpane

sTask = Application.CommandBars("Task Pane").NameLocal

'Handle for XLMAIN
hMain = Application.hWnd

'Find the OfficeClipboard Window
'2 methods as we're not sure if it's visible
'ONCE it has been made visible the windowclass is created
'and remains loaded for the duration of the instance
Do
hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)

hParent = hExcel2: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", sTask)
If hWindow Then
hParent = hWindow: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane",
vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9",
vbNullString)
If hClip > 0 Then
Exit Do
End If
End If
End If
Loop While hExcel2 > 0

If hClip = 0 Then
hParent = hMain: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane",
vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9",
vbNullString)
End If
End If
If hClip = 0 Then
ClipWindowForce

hParent = hMain: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane",
vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9",
vbNullString)
End If
End If
If hClip = 0 Then
MsgBox "Cant find Clipboard window"
Exit Sub
End If

lParameter = MakeLong(120, 18)
Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
Sleep 100
DoEvents

End Sub

Sub ClipWindowForce()
Dim octl
With Application.CommandBars("Task Pane")
If Not .Visible Then
Application.ScreenUpdating = False
Set octl = Application.CommandBars(1).FindControl(ID:=809,
recursive:=True)
If Not octl Is Nothing Then octl.Execute
.Visible = False
Application.ScreenUpdating = True
End If
End With
End Sub






--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


RAFAAJ2000 wrote :
 
Thanks Michel Pierron,
It appears the link you provided is broken !


KeepITCool, that is a beautiful piece of code !!
I asked this question so many times before but couldn' get an answer
anywhere...Thanks for that.

I have a couple of questions if you don't mind.

1- Why didn't you use SendMessage instead od PostMessage ?

2- How does the PostMessage function know which button should recieve the
WM_LBUTTON message ?

3- How does that MakeLong(120, 18) function work ?

Looking forward to hearing fro you.

Jaafar.

Regards.
 
But DO have a look at the code from Michel Pierron.
the link works fine. Try:
http://www.google.fr/groups?th=261537384f83ed7b

He uses a very elegant approach...by enumerating the ole controls thru
oleaccesibility.

However his code is LANGUAGE SENSITIVE and works for English excel only.
(not easily solved) and case sensitive (easily solved).

His code looks for 'Clear all' button.. and missed it on my versions as
the Button is named 'Clear All'. Solved by adding

Option Compare Text at the top of his code.


Maybe I'll try to adapt his code to allow multilanguage support.
it's shown me how to gain illegal entry into the "bosa_xlm" dialogs
Just what I need..sometimes :)



For My code:

I found it needs a correction in case the pane is smaller than 160
pixels... ClearAll button will reposition below iso beside the PasteAll

adapted code follows below

1- Why didn't you use SendMessage instead od PostMessage ?

Postmessage is async.. the msg is simply placed in the messagequeue
of the thread that owns specified window and the code will continue...
The messagequeue will be read and processed when the thread has time to
do so. Hence the sleep and doevents.
The window does NOT need to be visible or have focus, but maybe you
should test IsWindowEnabled to see if it will accept input

read more by googling 'msdn postmessage'
2- How does the PostMessage function know which button should recieve
the WM_LBUTTON message ?

the Message is posted to specified window..
at the (CLIENT!) coordinates passed in lParam.
3- How does that MakeLong(120, 18) function work ?

Iso 2 integers or PointApi the x,y coord for the buttonclick is passed
as a long. x = HiWord y = Loword... created with MakeLong function.


code should be adapted as follows:

Option Explicit
Private Const WM_LBUTTONDOWN As Long = &H201&
Private Const WM_LBUTTONUP As Long = &H202&
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" (ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function PostMessage Lib "user32.dll" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByRef lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32.dll" ( _
ByVal hwnd As Long, _
ByRef lpRect As RECT) As Long



'creates a long from two words (integers)
Private Function MakeLong(ByVal nLoWord As Integer, _
ByVal nHiWord As Integer) As Long
MakeLong = nHiWord * 65536 + nLoWord
End Function


Sub ClearOfficeClipboard()
Dim hMain&, hExcel2&, hClip&, hWindow&, hParent&
Dim lParameter&
Dim sTask$

'Author: keepITcool
'Note : betatested in xlXP and xl2003
' : adjusted for small pane w/ shifted button


'Get the localized caption of the taskpane
sTask = Application.CommandBars("Task Pane").NameLocal

'Handle for XLMAIN
hMain = Application.hwnd

'Find the OfficeClipboard Window
'2 methods as we're not sure if it's visible
Do
hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", _
vbNullString)

hParent = hExcel2: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, _
"MsoCommandBar", sTask)
If hWindow Then
hParent = hWindow: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, _
"MsoWorkPane", vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, _
"bosa_sdm_XL9", vbNullString)
If hClip > 0 Then
Exit Do
End If
End If
End If
Loop While hExcel2 > 0

If hClip = 0 Then
hParent = hMain: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", _
vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", _
vbNullString)
End If
End If
If hClip = 0 Then
'ONCE it has been made visible the window is created
'and remains loaded for the duration of the instance

ClipWindowForce

hParent = hMain: hWindow = 0
hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", _
vbNullString)
If hWindow Then
hParent = hWindow: hWindow = 0
hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", _
vbNullString)
End If
End If
If hClip = 0 Then
MsgBox "Cant find Clipboard window"
Exit Sub
End If

Dim rcC As RECT
Call GetClientRect(hClip, rcC)
lParameter = IIf(rcC.Right < 160, MakeLong(36, 42), _
MakeLong(120, 18))
Call PostMessage(hClip, WM_LBUTTONDOWN, 0&, lParameter)
Call PostMessage(hClip, WM_LBUTTONUP, 0&, lParameter)
Sleep 100
DoEvents

End Sub

Sub ClipWindowForce()
'shows (and hides) the office clipboard.
'forces creation of the clipboard window.
Dim octl
With Application.CommandBars("Task Pane")
If Not .Visible Then
Application.ScreenUpdating = False
Set octl = Application.CommandBars(1).FindControl( _
ID:=809, recursive:=True)
If Not octl Is Nothing Then octl.Execute
.Visible = False
Application.ScreenUpdating = True
End If
End With
End Sub


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


RAFAAJ2000 wrote :
 
Michel ..

VERY,VERY nice..
I have now a way into the bosa_xlm!

I've been dabbling a bit..
See my other posts in this thread for my original apporach.

Iso ENumChildWindows I've used a more agressive approach
to find the clip window also if it's hidden and not
'parented' by XLMAIN)


I am worried about language sensitivity of your code.

You'll need to read the localized caption of the taskpane from
the commandbar's .NameLocal... but that's easy :)

But then comes the point of finding the localized Buttons..
For xlXP and 2003 I have english software only so I cannot test.
However I'm fairly sure that 'Clear All' cant be found in a French
version. But the buttons parent (the Propertypage) has a non localized
name...


Do you have a non english version?..
if so can you check that the property page
( ROLE_SYSTEM_PROPERTYPAGE = &H26 ) is named
"Collect and Paste 2.0"
even in french version..

if so we can just press button 2 on that page.
(have code already complete, will mail or post if needed)




--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Michel Pierron wrote :
 
Hi keepITcool,

Unfortunately not; in the French version, the property page is "Collecte et
collage 2.0" and the buttons captions are "Coller tout " and "Effacer
tout".
I currently do not have either a solution with this problem.

MP
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top