VBA Express : Excel - Mac: Fetch absolute (w.r.t. monitor corner) position for named window

Excel

Mac: Fetch absolute (w.r.t. monitor corner) position for named window

Ease of Use

Easy

Version tested with

X (Mac)

Submitted by:

BlueCactus

Description:

Returns the Left, Top coordinates, as well as Width, Height for a named window in Mac Excel. Left and Top are for the top-left corner of the window, relative to the monitor top-left corner. Includes test subroutine to demonstrate code. Also works in Word. THIS CODE IS NOT FOR WINDOWS!

Discussion:

Mac Excel (and Word) do not provide a direct way of obtaining the absolute coordinates of an open window.* The function GetWinDimen() creates an AppleScript function to obtain this information (in units of pixels), returning the results in a variant array: (.Left, .Top, .Width, .Height). The subroutine TestGetWinDimen demonstrates how to call the function, and interpret the results. Typical Use: Userform positions are given relative to the monitor origin. So, in order to align something in the active window with an open userform, you need to know the absolute position of the active window. THIS CODE IS NOT FOR WINDOWS OFFICE! [* TECHNICAL: Win Excel is wrapped in an application window. The coordinates (Application.Left, Application.Top) give the application window's location (top-left corner) relative to the top-left corner of the monitor. The location of the active window (top-left corner) with respect to the application window is then given by (ActiveWindow.Left, ActiveWindow.Top). Mac Excel has no application window because all of its windows and toolbars float freely on the Mac OS X desktop. Therefore, in Mac Office, (Application.Left, Application.Top) always returns (0,0).]

Code:

instructions for use

			Sub TestGetWinDimen() 
     '   This is a test subroutine to demonstrate calling GetWinDimen()
    Dim winDimen As Variant, winTitle As String 
     
     '   Pick a window name based on the Office application running this macro
     '   Note that function GetWinDimen() does not need altering for different apps
    If InStr(Application.Name, "Excel") Then 
        winTitle = ActiveWorkbook.Name 
    ElseIf InStr(Application.Name, "Word") Then 
        winTitle = Activedocument.Name 
    End If 
     
    winDimen = GetWinDimen(winTitle) 
     
    If IsArray(winDimen) Then 
        MsgBox "Window: " & winTitle & Chr(13) & ".Left = " & winDimen(0) & _ 
        "; .Top = " & winDimen(1) & Chr(13) & ".Width = " & winDimen(2) & "; .Height = " & winDimen(3) 
    Else 
        MsgBox winDimen & " [No result - Is your window name correct?]" 
    End If 
End Sub 
 
Function GetWinDimen(ByVal winName As String) As Variant 
    Dim scr1 As String, scrRet As String 
    Dim x As Variant, y As Variant, w As Variant, h As Variant, i As Integer 
     
     '   Create the AppleScript in scr1. Note that double-double quotes are used to insert one pair double quotes
    scr1 = "tell application """ & Application.Name & """" & Chr(13) 
    scr1 = scr1 + "try" & Chr(13) 
    scr1 = scr1 + "set rect to bounds of window """ & winName & """" & Chr(13) 
    scr1 = scr1 + "on error" & Chr(13) 
    scr1 = scr1 + "set rect to ""error""" & Chr(13) 
    scr1 = scr1 + "end try" & Chr(13) 
    scr1 = scr1 + "end tell" & Chr(13) 
    scr1 = scr1 + "return rect" 
     
     '   ScrRet will be of the general format "xx1, yy1, xx2, yy2" - top left and bottom right corners.
     '   ScrRet will be set to "error" if the window name is bad.
    scrRet = MacScript(scr1) 
     
    If scrRet <> "error" Then 
         '       Valid values returned - extract and place in GetWinDimen()
        x = Val(Left(scrRet, InStr(scrRet, ",") - 1)) 
        i = InStr(scrRet, ",") + 1 
        y = Val(Mid(scrRet, i, InStr(i, scrRet, ",") - i)) 
        i = InStr(i, scrRet, ",") + 1 
        w = Val(Mid(scrRet, i, InStr(i, scrRet, ",") - i)) - x 
        i = InStr(i, scrRet, ",") + 1 
        h = Val(Mid(scrRet, i, Len(scrRet))) - y 
         
        GetWinDimen = Array(x, y, w, h) 
    Else 
        GetWinDimen = "error" 
    End If 
End Function

How to use:

Open Excel or Word.
Option + F11 to open the VBE.
Insert | Module
Paste code from above into new window.
Excel | Close and Return to Microsoft Excel
Test code (instructions below)

Test the code:

Tools | Macros | Macros...
Select TestWinDimen and hit Run

Sample File:

No Attachment

Approved by mdmackillop

This entry has been viewed 63 times.