Form Positioning in Excel 2007/2010 / Api & Windows-Classnames

[Chris Drontheim]

Hello,

I'm struggling with adapting this code:

http://www.cpearson.com/excel/formposition.htm

for using in Excel 2007/ 2010. The Problem with the old code is: There are metrics which are based on the old (pre-2k7) commandbars & menus, not on the new ribbon. The main question seems to me: How to measure the height of the Ribbon Pane? At the moment I have nothing but a vague idea. Maybe it' possible to find out the measure of the ribbon pane with api-functions. But I'm stuck from the start. Below I'm trying to find the handle of the ribbon pane. I get an hwnd, but this is the wrong one, it's the bar on the bottom of the screen. I'm using this tool for validating my attempts: http://www.xcelfiles.com/API_06.html.

The first question: What classnames in which order to choose, to get the ribbon handle?

If this is solved and my idea is still the route to go, how could it ported to the pearson-code? Thank you for help.

Declare Function GetWindowRect Lib "User32" (ByVal hWnd As Long, Rect As Rect) As Long 
Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long 
Declare Function FindWindowA Lib "User32" _ 
(ByVal lpClassName As Any, _ 
ByVal lpWindowName As String) As Long 
 
Private Type Rect 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
 
Sub FindRibbonHandleNSize() 
     
    Dim RibbonHwnd As Long 
    Dim ExcelMainHwnd As Long 
    Dim aRect As Rect ' receives the rectangle of the window
     
     
    ExcelMain = FindWindowA("XLMAIN", Application.Caption) 
    RibbonHwnd = FindWindowEx(ExcelMain, 0, "Excel2", vbNullString) 
    RibbonHwnd = FindWindowEx(RibbonHwnd, 0, "MsoCommandBar", vbNullString) 
    RibbonHwnd = FindWindowEx(RibbonHwnd, 0, "MsoWorkPane", vbNullString) 
    RibbonHwnd = FindWindowEx(RibbonHwnd, 0, "NUIPane", vbNullString) 
    RibbonHwnd = FindWindowEx(RibbonHwnd, 0, "NetUIHWND", vbNullString) 
     
     
    Call GetWindowRect(RibbonHwnd, aRect) 
    Debug.Print " Left: " & aRect.Left 
    Debug.Print " Right: " & aRect.Right 
    Debug.Print " Top: " & aRect.Top 
    Debug.Print " Bottom: " & aRect.Bottom 
    Debug.Print " Width: " & (aRect.Right - aRect.Left) 
    Debug.Print " Height: " & (aRect.Bottom - aRect.Top) 
     
End Sub 

[rory]

application.CommandBars("Ribbon").Height 

will give you the height of the ribbon.

[Chris Drontheim]

Hello Rory, thank you. That simple, huh.

[rory]

Yes, but that doesn't include the formula bar, which of course can be resized...

Most annoying is that the Excel chart window no longer exists - that was by far the simplest way to position a userform, in my opinion.

[Chris Drontheim]

Thank for the hint. Could the first question modified to: How to find out, what size the formular bar is?

[rory]

Simplest thing is probably to locate the part containing the Name box and use that:

Sub FindRibbonHandleNSize() 
     
    Dim RibbonHwnd As Long 
    Dim ExcelMain As Long 
    Dim aRect As Rect ' receives the rectangle of the window
     
     
    ExcelMain = FindWindowA("XLMAIN", Application.Caption) 
    RibbonHwnd = FindWindowEx(ExcelMain, 0, "Excel;", vbNullString) 
     
     
    Call GetWindowRect(RibbonHwnd, aRect) 
    Debug.Print " Left: " & aRect.Left 
    Debug.Print " Right: " & aRect.Right 
    Debug.Print " Top: " & aRect.Top 
    Debug.Print " Bottom: " & aRect.Bottom 
    Debug.Print " Width: " & (aRect.Right - aRect.Left) 
    Debug.Print " Height: " & (aRect.Bottom - aRect.Top) 
     
End Sub 

[Chris Drontheim]

Yes, good one. Maybe this is even better:

ExcelMain = FindWindowA("XLMAIN", Application.Caption)
formulaBarHwnd = FindWindowEx(ExcelMain, 0, "EXCEL<", vbNullString).

Is seems, "EXCEL<" is the classname of the formula-window.

Thank you very much.

[Harrys]

Sub GetScreenStats() 
    ZFS = ActiveWindow.Zoom / 100 
    Hdc = GetDC(0) ' find pixels to Points ratio  (3:4)
    PixToPts.x = 72 / (GetDeviceCaps(Hdc, 88)) 
    PixToPts.y = 72 / (GetDeviceCaps(Hdc, 90)) 
    ReleaseDC 0, Hdc 
    PtsToPix.x = 1 / PixToPts.x ' both 4/3
    PtsToPix.y = 1 / PixToPts.y '
     ' the offset in pts  from edge of screen to top left cell
    OffsetPT.x = ActiveWindow.PointsToScreenPixelsX(0) * PixToPts.x 
    OffsetPT.y = ActiveWindow.PointsToScreenPixelsY(0) * PixToPts.y 
    Set ActWinVis = ActiveWindow.Application.ActiveWindow.VisibleRange 
    AppFormOffPt.x = ActiveWindow.Left * 2 + 10 ' why doubled  10 is 2 borders
    AppFormOffPt.y = ActiveWindow.Top 
     
     
     'ActiveWindow.Application.ActiveWindow.VisibleRange
End Sub 

The main useful trick seems to be

OffsetPT.x = ActiveWindow.PointsToScreenPixelsX(0) * 3/4 ' PixToPts.x
OffsetPT.y = ActiveWindow.PointsToScreenPixelsY(0) *3/4 ' PixToPts.y
this gives the location on the screen of the left top of cell A1..
no mater what height of menu on the top or what side width menu bars you have on the left ''
or what cell you have scrolled to ... if you have cell AM1456 left top then A! is well off the screen

 'since people like to change screen size max min
 ' we need functions that will recalculate each time
 'in the event that windows are zoomed , scrolled
 'or if menus top or left are resized inserted or deleted
 'you need to run a tidy routine to  correctly reposition the objects
 '
 'hopefully you can sort out some ideas from the   code below
 '
 
Declare Function GetDC& Lib "user32" (ByVal hwnd&) 
Declare Function GetForegroundWindow& Lib "user32" () 
Declare Function ReleaseDC& Lib "user32" (ByVal hwnd&, ByVal Hdc&) 
Declare Function GetDeviceCaps& Lib "gdi32" (ByVal Hdc&, ByVal nIndex&) 
Declare Function GetCursorPos& Lib "user32" (lpPoint As LPoint) 
Declare Function SetCursorPos& Lib "user32" (ByVal x&, ByVal y&) 
Public Enum MovNum 
    generalpt = 1 
    FormPt = 2 
    MouseToPt = 3 
    MouseMovePt = 4 
End Enum 
Public Type LPoint 
    x As Long 
    y As Long 
End Type 
Public Type SPoint 
    x As Single 
    y As Single 
End Type 
Type MouseCommand ' INPUT structure
    iType As Long ' 0 for mouse, 1 for kbd
    iDx As Long ' rel movt in pixels (unless ABSOLUTE)
    iDy As Long 
    iWheelData As Long ' we don't use this
    iFlags As Long ' we use this (see MOUSEEVENT flags below)
    iTime As Long ' don't use this
    iXtra As Long ' or this
End Type 
Const SM_CYCAPTION As Long = 4 
Const MOUSEEVENTF_LEFTDOWN = &H2 ' left button down
Const MOUSEEVENTF_LEFTUP = &H4 ' left button up
Const MOUSEEVENTF_MOVE As Long = &H1 ' mouse move
Const MOUSEEVENTF_RIGHTDOWN As Long = &H8 ' right button down
Const MOUSEEVENTF_RIGHTUP As Long = &H10 ' right button up
Const MOUSEEVENTF_MIDDLEDOWN As Long = &H20 ' middle button down
Const MOUSEEVENTF_MIDDLEUP As Long = &H40 ' middle button up
Const MOUSEEVENTF_ABSOLUTE As Long = &H8000 ' absolute move
Const MOUSEEVENTF_WHEEL As Long = &H800 ' wheel button rolled
Declare Function SendInput& Lib "user32.dll" _ 
(ByVal nCommands&, iCommand As MouseCommand, ByVal cSize&) 
Public PixToPts As SPoint, PtsToPix As SPoint 
Public ZFS!, Hdc&, OffsetPT As LPoint, AppFormOffPt As LPoint, CtrlOb ' As Control
Public IsMoveOb As Boolean, ActWinVis As Object 
 
Type Wob ' working Object
    PassName As String ' passed string to get data from
    ObType As String 
    Name As String 
    SubName As String 
    MoveType As String 
    MoveNum As Integer 
    Ob As Object 
    ZoomForm As Single ' for finding controls in a zoomed form
    WXPer As Single ' width or x values percent to pick point
    HyPer As Single ' height or y  values percent to pick point
    OFFWX As Single ' offset width or X   from picked point
    OFFHY As Single ' offset height or Y from picked pt
     ' the offsets can be uses to hit on buttons on right of forms etc
     'not much used
    TLtoPickPt As LPoint ' the offset from top left to pick point
    PtPix As LPoint ' a general Pt in Pix used for cursor
    PtPts As LPoint ' a general Pt in Points
End Type 
 ' Move Object      To Object  and Blank Object
Public Mob As Wob, Tob As Wob, Bob As Wob 
Sub MouseAndClick() 
    Dim mCommand As MouseCommand 
    With mCommand 
        .iFlags = MOUSEEVENTF_LEFTDOWN 
        SendInput 1&, mCommand, Len(mCommand) 
        .iFlags = MOUSEEVENTF_LEFTUP 
        SendInput 1&, mCommand, Len(mCommand) 
    End With 
End Sub 
 '                               A    B    C   D   E   F
 '  Screen to sheet Margin  !    work sheet area columns     *Object        right of worksheet areas
 '<-----  Offset --------- 1 >    |   |   |   |   |   |   |   |   |   |   |   |   |   |
 '            side menus   2
 '
 '.......... pixels from side of screen IS Mouse CURSOR......>*  (Pixel = .75 of point most times)
 '
 '                    Pixels refer to screen dots and are not changed by zooming
 '.......... Form points (FPt).....(No zooming)...............>*   (but a form zooms inside it )
 '
 '           ( so a mouse position is always  Form * 4/3  .) .both not zoomed
 '
 '  .... UnZoomed offset... !....sheet  can be zoomed .General  Points  (GPt) ...>*
 ' ..  So Below is how to change
 ' The main  clue  is that the
 '   ActiveWindow.PointsToScreenPixelsX(0)
 '   gives the side of screen offset in pixels ..
 '   for all scrolls margins and side menus   ( I hope )
 'These are coded as
 'GPt as general Point  .. shapes including ole objects
 '   Mo as mouse cursor,
 ' Fo as form .. normal .. child of application has lots of funny app tops and lefts
Function GPtMo(Gpt As LPoint) As LPoint 
    GPtMo.x = (Gpt.x * ZFS + OffsetPT.x) * PtsToPix.x 
    GPtMo.y = (Gpt.y * ZFS + OffsetPT.y) * PtsToPix.y 
End Function 
Function MoGpt(Mpt As LPoint) As LPoint 
    MoGpt.x = (Mpt.x * PixToPts.x - OffsetPT.x) / ZFS 
    MoGpt.y = (Mpt.y * PixToPts.y - OffsetPT.y) / ZFS 
End Function 
Function MoFo(Mpt As LPoint) As LPoint 
    MoFo.x = Mpt.x * PixToPts.x 
    MoFo.y = Mpt.y * PixToPts.y 
End Function 
Function FOMo(Fpt As LPoint) As LPoint 
    FOMo.x = Fpt.x * PtsToPix.x 
    FOMo.y = Fpt.y * PtsToPix.y 
End Function 
Function GPtFo(Gpt As LPoint) As LPoint 
    GPtFo.x = Gpt.x * ZFS + OffsetPT.x 
    GPtFo.y = Gpt.y * ZFS + OffsetPT.y 
End Function 
Function FoGPT(Fpt As LPoint) As LPoint ' inv of above
    FoGPT.x = (Fpt.x - OffsetPT.x) / ZFS 
    FoGPT.y = (Fpt.y - OffsetPT.y) / ZFS 
End Function 
Sub DoMoveMT() 
    If Mob.ObType <> "Cursor" Then 
         ' changeing width, height of move ob  to sizes of to object  .. not < 10%
        Mob.Ob.Left = Tob.PtPts.x - Mob.TLtoPickPt.x 
        Mob.Ob.Top = Tob.PtPts.y - Mob.TLtoPickPt.y 
    Else 
         ' MsgBox Tob.PtPts.X
        SetCursorPos Tob.PtPts.x, Tob.PtPts.y 
    End If 
End Sub 

[Chris Drontheim]

Hi Harrys,

that looks very promising, I'll try to figure it out. Thank you very much. For my inital problem I've taken another route. At http://proexceldev.net I've found an updated Version of their Form-positioning-module, which is very good. Sadly no hyperlink possible, you have to register over there. But worth a look, if you are still interested in.

Viele Grüße