获取 Visio 应用程序的 Window 个位置
Get Window position of a Visio Application
简介：
当我尝试相对于调用 Visio 应用程序 window 定位 Visio-UserForms 时，我 运行 遇到了一个问题，因为它可能在其他 MS Office 应用程序中。
通常我会像第一个块 (Excel) 那样使用调用代码在应用程序 window.
的相对位置打开用户窗体
此问题的重要属性是 .Left 和 .Top，其中 return window 相对于屏幕的偏移量。
如果我在 Visio（代码块 2）中尝试相同的操作，我 运行 会出现以下问题：
Visio 应用程序 (vsApp) 的应用程序对象不支持 .Top 和 .Left 属性，所以显然我得到了标准 Run.time error "438": “Object doesn't support this property or method”
问题：
我的问题是是否有另一种相对干净的方法来获取调用应用程序（甚至可能与应用程序无关）的 window 位置。环顾四周，Excel 有多种解决方案，但据我所知，Visio 有 none。
这是我的第一个问题，所以如果我提交错误或遗漏了 rule/guideline 请告诉我。
代码：
在这两种情况下，FooUserForm 都是一个简单的用户窗体，带有一个隐藏带有 Me.Hide 的表单的按钮。下面的代码驻留在标准模块中
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
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
因为我假设在许多其他项目中使用它，所以我创建了一个包含所有代码的 class。 class 目前在 32 位上工作，主要是因为我找不到从 Visio 应用程序对象获取 64 位句柄的方法。
由于使用了 LongPtr 类型，代码本身是 64 位的。更多信息在这里：https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
这些声明应该有效，因为它们是在 64 位环境中重新创建的。
class 公开了 13 个属性，其中 12 个是 Window 位置和大小，一个是句柄，这允许用户针对不同的 window 而不是应用程序.这可用于相对于在“主”应用程序中打开的 window 定位用户窗体。
Office UserForms（出于某种原因）使用点而不是像素在屏幕上定位自己，为了帮助解决这个问题，我还构建了一个到 class.
的转换
还有一些我想改变的开放的东西，比如添加适当的错误处理和可能给 class 一个默认实例，但现在这是可用的。
资源
http://officeoneonline.com/vba/positioning_using_pixels.html
http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position
说明
这Module/Class会发生什么？
- class 处理与 Windows API
的交互
- 它创建了一个
Private Type Rect，它被 GetWindowRect 函数使用。
- 它声明了
GetWindowRect 函数，它采用 window 的 window 句柄（很明显）和 returns [=] 中“大纲”的位置51=]像素
- 初始化对象时，它会自动存储在
this.Handle 中调用它的应用程序的 window 句柄
- 当获取
px__ 属性之一时，它只是更新 window 位置 this.rc 和 returns 所需的值。
- 当获取
pt__ 属性时，它会更新 window 位置并计算等效的点数，这很有用，因为 VBA 用户窗体实际上使用点数进行定位。转换描述为 here.
- windows 句柄可以通过设置
Handle 属性 来更改，这提供了更多的灵活性，例如当同一应用程序的多个 windows打开。
代码
aModule（模块）
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
Window定位器(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
您只需在 Visio 中使用 Application.Window.GetWindowRect 而不是 Application.Top 和 Application.Left 来获取主要 window 坐标（由于历史原因 - 当 Visio 成为大约 20 年前的 Microsoft Office，这个 API 已经存在，它与您所指的其他办公应用程序不同）。无论如何，这个主题可以比接受的答案更容易完成：
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
简介：
当我尝试相对于调用 Visio 应用程序 window 定位 Visio-UserForms 时，我 运行 遇到了一个问题，因为它可能在其他 MS Office 应用程序中。
通常我会像第一个块 (Excel) 那样使用调用代码在应用程序 window.
的相对位置打开用户窗体
此问题的重要属性是 .Left 和 .Top，其中 return window 相对于屏幕的偏移量。
如果我在 Visio（代码块 2）中尝试相同的操作，我 运行 会出现以下问题：
Visio 应用程序 (vsApp) 的应用程序对象不支持 .Top 和 .Left 属性，所以显然我得到了标准 Run.time error "438": “Object doesn't support this property or method”
问题：
我的问题是是否有另一种相对干净的方法来获取调用应用程序（甚至可能与应用程序无关）的 window 位置。环顾四周，Excel 有多种解决方案，但据我所知，Visio 有 none。
这是我的第一个问题，所以如果我提交错误或遗漏了 rule/guideline 请告诉我。
代码：
在这两种情况下，FooUserForm 都是一个简单的用户窗体，带有一个隐藏带有 Me.Hide 的表单的按钮。下面的代码驻留在标准模块中
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
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
因为我假设在许多其他项目中使用它，所以我创建了一个包含所有代码的 class。 class 目前在 32 位上工作，主要是因为我找不到从 Visio 应用程序对象获取 64 位句柄的方法。
由于使用了 LongPtr 类型，代码本身是 64 位的。更多信息在这里：https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
这些声明应该有效，因为它们是在 64 位环境中重新创建的。
class 公开了 13 个属性，其中 12 个是 Window 位置和大小，一个是句柄，这允许用户针对不同的 window 而不是应用程序.这可用于相对于在“主”应用程序中打开的 window 定位用户窗体。
Office UserForms（出于某种原因）使用点而不是像素在屏幕上定位自己，为了帮助解决这个问题，我还构建了一个到 class.
的转换还有一些我想改变的开放的东西，比如添加适当的错误处理和可能给 class 一个默认实例，但现在这是可用的。
资源
http://officeoneonline.com/vba/positioning_using_pixels.html
http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position
说明
这Module/Class会发生什么？
- class 处理与 Windows API 的交互
- 它创建了一个
Private Type Rect，它被GetWindowRect函数使用。 - 它声明了
GetWindowRect函数，它采用 window 的 window 句柄（很明显）和 returns [=] 中“大纲”的位置51=]像素 - 初始化对象时，它会自动存储在
this.Handle 中调用它的应用程序的 window 句柄
- 当获取
px__属性之一时，它只是更新 window 位置this.rc和 returns 所需的值。 - 当获取
pt__属性时，它会更新 window 位置并计算等效的点数，这很有用，因为 VBA 用户窗体实际上使用点数进行定位。转换描述为 here. - windows 句柄可以通过设置
Handle属性 来更改，这提供了更多的灵活性，例如当同一应用程序的多个 windows打开。
代码
aModule（模块）
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
Window定位器(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
您只需在 Visio 中使用 Application.Window.GetWindowRect 而不是 Application.Top 和 Application.Left 来获取主要 window 坐标（由于历史原因 - 当 Visio 成为大约 20 年前的 Microsoft Office，这个 API 已经存在，它与您所指的其他办公应用程序不同）。无论如何，这个主题可以比接受的答案更容易完成：
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