Hi quartz,
No object model for the Office Clipboard, so there is no way to
programmatically manipulate it.
http://support.microsoft.com/kb/221190/en-us
If one lists all the Excel windows with the "ExcelChildWindows" following
procedure, one does not find a handle for the "Clear all" button.
The only way to do it is clicking the "Clear All" button on the Office
Clipboard task pane. Fortunately Active Accessibility (MSAA) provides a way
to do it from your program.
Then what is MSAA? I don't think I can explain it better than what you can
find on MSDN. So please check out the the MSAA section if you want to know
more about it.
I tested too with MSAA method and I never could find the "Clear all" button.
Option Explicit
Private Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long _
, ByVal lParam 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 GetParent Lib "user32" _
(ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hWnd As Long _
, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias _
"GetWindowTextA" (ByVal hWnd As Long _
, ByVal lpString As String, ByVal cch As Long) As Long
Private Type xlWin
Level As Byte
Parent As Long
Handle As Long
Class As String
Title As String
End Type
Private xlWins() As xlWin, i%, lMax%
Private Function Level(ByVal hWnd&) As Byte
While GetParent(hWnd) <> 0
Level = Level + 1
hWnd = GetParent(hWnd)
Wend
End Function
Private Sub WriteParam(ByVal hWnd&, i%)
ReDim Preserve xlWins(2 To i)
With xlWins(i)
..Level = Level(hWnd)
..Parent = GetParent(hWnd)
..Handle = hWnd
..Class = ClassName(hWnd)
..Title = WindowText(hWnd)
If .Level > lMax Then lMax = .Level
End With
End Sub
Sub ExcelChildWindows()
Application.ScreenUpdating = False
ActiveSheet.UsedRange.Offset(1, 0).ClearContents
Application.CommandBars(1).Controls(2).Controls(5).Execute
Dim hWnd As Long
i = 2: lMax = 0
hWnd = FindWindow(vbNullString, Application.Caption)
Call WriteParam(hWnd, i)
EnumChildWindows hWnd, AddressOf EnumChildProc, ByVal 0&
For i = 2 To UBound(xlWins)
Cells(i, 1) = xlWins(i).Level
Cells(i, 2 + xlWins(i).Level) = xlWins(i).Class
Cells(i, 3 + lMax) = xlWins(i).Handle
Cells(i, 4 + lMax) = xlWins(i).Parent
Cells(i, 5 + lMax) = xlWins(i).Title
Next i
If Cells(1, 1) = "" Then Call Headers
Range("A1").Select
Columns(1).Columns.AutoFit
For i = 2 To lMax + 1
Columns(i).ColumnWidth = 1
Next i
Columns(lMax + 2).ColumnWidth = 13
Erase xlWins
End Sub
Function EnumChildProc(ByVal hWnd As Long _
, ByVal lParam As Long) As Long
i = i + 1
Call WriteParam(hWnd, i)
EnumChildProc = 1
End Function
Private Function ClassName(ByVal hWnd&) As String
Dim lpClassName As String, RetVal As Long
lpClassName = Space(256)
RetVal = GetClassName(hWnd, lpClassName, 256)
ClassName = Left$(lpClassName, RetVal)
End Function
Private Function WindowText(ByVal hWnd&) As String
Dim Buffer As String
Buffer = String(100, Chr$(0))
GetWindowText hWnd, Buffer, 100
WindowText = Left$(Buffer, InStr(Buffer, Chr$(0)) - 1)
End Function
Private Sub Headers()
Rows(1).Font.Bold = True
Cells(1, 1) = "LEV."
Cells(1, 1).EntireColumn.HorizontalAlignment = xlCenter
Cells(1, 2) = "CLASSNAME"
Cells(1, 3 + lMax) = "HANDLE"
Cells(1, 3 + lMax).HorizontalAlignment = xlRight
Cells(1, 4 + lMax) = "PARENT"
Cells(1, 4 + lMax).HorizontalAlignment = xlRight
Cells(1, 5 + lMax) = "TITLE"
Cells(1, 5 + lMax).EntireColumn.NumberFormat = "@"
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
Regards,
MP
