Get Window position of a Visio Application - vba

Question

Intro:
I've run into an issue when I tried to position Visio-UserForms relative to the calling Visio application window, as it is possible in other MS Office applications.
Normally I would use calling code like in the first block (Excel) to open a UserForm in a relative position to the application window.
The important properties for this uqestion are .Left and .Top, which return the offset of the window compared to the screen.
If I try the same in Visio (code block 2) I ran into the following Issue:
The application object of a the Visio application (vsApp) does not support the .Top an .Left properties, so obviously I get the standart Run.time error "438": “Object doesn't support this property or method”
Question:
My question is if there is an alternative relatively clean method to get the window position of the calling application (maybe even application-agnostic). When looking around there are a multitude of solutions for Excel, but none for Visio as far as I can tell.
This is my first question here, so please if I submitted something wrong or missed a rule/guideline please let me know.
Code:
In both cases the FooUserForm is a simple UserForm with a single button that hides the form with Me.Hide. The code below resides in a standard module
Code in Excel:
Option Explicit
Sub openFooUserForm()
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
Dim exApp As Excel.Application
Set exApp = ThisWorkbook.Application
fooUF.StartUpPosition = 0
fooUF.Top = exApp.Top + 25
fooUF.Left = exApp.Left + 25
fooUF.Show
Set fooUF = Nothing
End Sub
Code in Visio:
Option Explicit
Sub openFooUserForm()
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
Dim vsApp As Visio.Application
Set vsApp = ThisDocument.Application
fooUF.StartUpPosition = 0
fooUF.Top = vsApp.Top + 25
fooUF.Left = vsApp.Left + 25
fooUF.Show
Set fooUF = Nothing
End Sub

Answer 1

Since I assume to use this in many other project, I created a class containing all the code. The class works in 32-bit for now, mostly because I couldn't find a way to get the 64-bit handle from the Visio Application Object.
The code itself is prepared 64-bit thanks to the use of the LongPtr type. More Info here: https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
The declarations should work since they were recreated in the 64-bit environment.
The class exposes 13 properties, 12 of these are Window positions and sizes and one is the Handle, this allows the user to target a different window instead of the application. This could be used to position a Userform in relation to a window opened inside the "Main" application.
Office UserForms (for some reason) use Points instead of Pixels to position themselves on the screen, to help with this I also built a conversion into the class.
There are still some things open that I want to change, like adding proper Error Handling and maybe giving the class a default Instance, but for now this is usable.
Resources
http://officeoneonline.com/vba/positioning_using_pixels.html
http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position
Explanation
What happens in this Module/Class?
The class handles the interaction with the Windows API
It creates a Private Type Rect, which is used by the GetWindowRect function.
It declares the GetWindowRect function, wich takes the window handle of a window (obviously) and returns the position of the "Outline" in pixels
When the object is initialized it automatically stores the window handle of the Application in which it was called in this.Handle
When getting one of the px__ properties it simply updates the window position this.rc and returns the desired value.
When getting on of the pt__ properties it updates the window position and calculates the equivalent in points, this is usefull since VBA Userforms actually use points for positioning. The conversion is described here.
The windows handle can be changed by setting the Handle Property, this provides some more flexibility, for example when a multiple windows of the same application are opened.
Code
aModule (Module)
Sub openFooUserForm()
Dim winPo As WindowPositioner
Set winPo = New WindowPositioner
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
fooUF.StartUpPosition = 0
fooUF.Top = winPo.ptTop + 100
fooUF.Left = winPo.ptLeft + 50
fooUF.Show
Set fooUF = Nothing
End Sub
WindowPositioner (Class)
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TWindowPositioner
Handle As LongPtr
rc As RECT
End Type
Private this As TWindowPositioner
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Sub Class_Initialize()
#If WIN64 THEN
'this.Handle = 'Method to get the 64-bit Handle of the Application Object
#Else
this.Handle = ThisDocument.Application.WindowHandle32
#End If
this.rc.Left = 0
this.rc.Top = 0
this.rc.Right = 0
this.rc.Bottom = 0
End Sub
Public Property Get Handle() As LongPtr
Handle = this.Handle
End Property
Public Property Let Handle(val As LongPtr)
this.Handle = val
End Property
Public Property Get pxTop() As Long
UpdatePosition
pxTop = this.rc.Top
End Property
Public Property Get pxLeft() As Long
UpdatePosition
pxLeft = this.rc.Left
End Property
Public Property Get pxBottom() As Long
UpdatePosition
pxBottom = this.rc.Bottom
End Property
Public Property Get pxRight() As Long
UpdatePosition
pxRight = this.rc.Right
End Property
Public Property Get pxHeight() As Long
UpdatePosition
pxHeight = this.rc.Bottom - this.rc.Top
End Property
Public Property Get pxWidth() As Long
UpdatePosition
pxWidth = this.rc.Left - this.rc.Right
End Property
Public Property Get ptTop() As Long
ptTop = CPxToPtY(pxTop)
End Property
Public Property Get ptLeft() As Long
ptLeft = CPxToPtX(pxLeft)
End Property
Public Property Get ptBottom() As Long
ptBottom = CPxToPtY(pxBottom)
End Property
Public Property Get ptRight() As Long
ptRight = CPxToPtX(pxRight)
End Property
Public Property Get ptHeight() As Long
ptHeight = CPxToPtY(pxBottom) - CPxToPtY(pxTop)
End Property
Public Property Get ptWidth() As Long
ptWidth = CPxToPtX(pxRight) - CPxToPtX(pxLeft)
End Property
Private Sub UpdatePosition()
GetWindowRect this.Handle, this.rc
End Sub
Private Function CPxToPtX(ByRef val As Long) As Long
Dim hDC As LongPtr
Dim RetVal As Long
Dim XPixelsPerInch As Long
hDC = GetDC(0)
XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
RetVal = ReleaseDC(0, hDC)
CPxToPtX = CLng(val * TWIPSPERINCH / 20 / XPixelsPerInch)
End Function
Private Function CPxToPtY(ByRef val As Long) As Long
Dim hDC As LongPtr
Dim RetVal As Long
Dim YPixelsPerInch As Long
hDC = GetDC(0)
YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
RetVal = ReleaseDC(0, hDC)
CPxToPtY = CLng(val * TWIPSPERINCH / 20 / YPixelsPerInch)
End Function

Answer 2

You simply need to use Application.Window.GetWindowRect instead of Application.Top and Application.Left in Visio to get the main window coordinates (for historical reasons - when Visio became part of the Microsoft Office some 20 years ago, this API already existed, and it was different from other office apps you are referring to). Anyways, the subject can be done easier than in the accepted answer:
Set vsApp = ThisDocument.Application
'''' here we go
Dim left As Long, top As Long, width As Long, height As Long
vsApp.Window.GetWindowRect left, top, width, height
fooUF.StartUpPosition = 0
fooUF.Top = top + 25
fooUF.Left = left + 25