View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default API to find position of active cell no longer working in 2007.

Hi Jeremy,

If you don't have Spy++ or equivalent, see if you can find your chartobject
window with the code below.

Run Test2 (at the bottom) and look for differences between the two calls to
'MySpy', without then with a chartobject window. In particular look for
"EXCELE" or if not found "SheetName SpyChart".

Assuming you find the right window you'll need to work back up the tree to
Excel's main window and start from there to find your activated
chartobject's chart window. Then for your purposes 'GetWindowRect' to return
its coordinates.

If the two calls to MySpy don't show any differences, change -
MySpy ActiveSheet, False True ( in both calls) to get all windows

Even in pre XL2007 some of Excel's windows are at the same 'level' as XLMAIN
and so would need to search from the desktop, or perhaps even from some
other window.

There's no error handling in the code. The array ArrWins is dimensioned to
accommodate 10000 windows. That's way more than enough for me but if your
system has more you'll need to increase it (unlikely necessary if passing
bDesktop as False to only get Excel's windows).

Regards,
Peter T


'''''''''''''''''''''''''''''''''''''''''''
' MySpy - Obtain Window details
' Based on Stephen Bullen's EnumDlg.xls (.zip)
' http://www.oaltd.co.uk/Excel/Default.htm
' although heavily adapted intrinsically it's the same
' see Stephen's original for comments
' whilst there see the link for 'Professional Excel Development'
'
' pmbthornton gmail com

Option Explicit

Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hwnd As Long, ByVal lpString As String, _
ByVal cch As Long) As Long

Public Const GW_HWNDFIRST = 0
'Public Const GW_HWNDLAST = 1
Public Const GW_HWNDNEXT = 2
'Public Const GW_HWNDPREV = 3
'Public Const GW_OWNER = 4
Public Const GW_CHILD = 5
'Public Const GW_MAX = 5

Sub Test()

MySpy ActiveSheet, True

ActiveSheet.Cells.Find("XLMAIN").Select

End Sub

Sub MySpy(mSht As Worksheet, bDesktop As Boolean)
Dim hWindFirst As Long
Dim nRow As Long, nCol As Long
Dim nMaxCols As Long

ReDim ArrWins(1 To 10000, 1 To 3) ' increase if +10000 windows

If Application.Version 9 Then
hWindFirst = Application.hwnd
Else
hWindFirst = FindWindow("XLMAIN", Application.Caption)
End If

If bDesktop = True Then
hWindFirst = GetWindow(hWindFirst, GW_HWNDFIRST)
End If

nRow = 1
nCol = 1

GetChildWindows 0, hWindFirst, ArrWins, nRow, nCol, nMaxCols, bDesktop

With mSht
.Range("A1").CurrentRegion.Clear
.Range(.Cells(1, 1), .Cells(nRow, nMaxCols)) = ArrWins
nRow = .UsedRange.Rows.Count '
End With

End Sub

Sub GetChildWindows(hParent As Long, hChild As Long, _
ArrWins(), nRow As Long, nCol As Long, _
nMaxCols, bDesktop As Boolean)
Dim sBuff As String * 128
Dim hwnNext As Long

If nCol + 2 nMaxCols Then nMaxCols = nCol + 2
If nMaxCols UBound(ArrWins, 2) Then
ReDim Preserve ArrWins(1 To UBound(ArrWins), 1 To nMaxCols)
End If

ArrWins(nRow, nCol) = hChild

Call GetClassName(hChild, sBuff, 128)
ArrWins(nRow, nCol + 1) = TrimBuffer(sBuff)

Call GetWindowText(hChild, sBuff, 128)
ArrWins(nRow, nCol + 2) = TrimBuffer(sBuff)

nRow = nRow + 1

hwnNext = GetWindow(hChild, GW_CHILD)

If hwnNext < 0 Then
GetChildWindows hChild, hwnNext, ArrWins, nRow, nCol + 1, _
nMaxCols, bDesktop
End If

If hParent < 0 Or bDesktop = True Then
hwnNext = GetWindow(hChild, GW_HWNDNEXT)
If hwnNext = 0 Then
Exit Sub
Else
GetChildWindows hParent, hwnNext, ArrWins, nRow, nCol, _
nMaxCols, bDesktop
End If
End If

End Sub

Public Function TrimBuffer(ByVal strIn As String) As String
Dim nPos As Long
nPos = InStr(1, strIn, vbNullChar, vbTextCompare)
If nPos 0 Then
TrimBuffer = Left(strIn, nPos - 1)
Else
TrimBuffer = strIn
End If
End Function

Sub Test2()
Dim chtObj As ChartObject

MySpy ActiveSheet, False

ActiveSheet.Range("A1").CurrentRegion.Columns.Inse rt

On Error Resume Next
Set chtObj = ActiveSheet.ChartObjects("SpyChart")
On Error GoTo 0
With ActiveSheet.Range("D2:E4")
If chtObj Is Nothing Then
Set chtObj = .Parent.ChartObjects.Add( _
.Left, .Top, .Width, .Height)
chtObj.Name = "SpyChart"
Else
chtObj.Left = .Left
chtObj.Top = .Top
chtObj.Width = .Width
chtObj.Height = .Height
'.Visible = True
End If
End With
chtObj.Activate

MySpy ActiveSheet, False

' delete or keep the chart for future use
'chtObj.Delete
Range("A1").Select
chtObj.Visible = False

End Sub

Peter T