获取 Visio 应用程序的窗口位置

Question

介绍：

\n\n

当我尝试将 Visio-UserForms 相对于调用的 Visio 应用程序窗口定位时，遇到了问题，这在其他 MS Office 应用程序中也是可能的。
\n通常我会使用第一个块（Excel）中的调用代码来在应用程序窗口的相对位置打开用户窗体。
\n这个问题的重要属性是.Left和.Top，它们返回窗口相对于屏幕的偏移量。

\n\n

如果我在 Visio 中尝试相同的操作（代码块 2），我会遇到以下问题：\nVisio 应用程序 ( vsApp) 的应用程序对象不支持.Top属性.Left，因此显然我得到了标准Run.time error "438": \xe2\x80\x9cObject doesn\'t support this property or method\xe2\x80\x9d

\n\n

问题：

\n\n

我的问题是是否有一种替代的相对干净的方法来获取调用应用程序的窗口位置（甚至可能与应用程序无关）。环顾四周，有很多针对 Excel 的解决方案，但据我所知，没有针对 Visio 的解决方案。

\n\n

这是我的第一个问题，所以如果我提交了错误的内容或错过了规则/指南，请告诉我。

\n\n

代码：

\n\n

在这两种情况下，FooUserForm 都是一个简单的用户表单，带有一个隐藏表单的按钮Me.Hide。下面的代码位于标准模块中

\n\n

Excel 中的代码：

\n\n

Option Explicit\n\nSub openFooUserForm()\n\n    Dim fooUF As FooUserForm\n    Set fooUF = New FooUserForm\n\n    Dim exApp As Excel.Application\n    Set exApp = ThisWorkbook.Application\n\n    fooUF.StartUpPosition = 0\n    fooUF.Top = exApp.Top + 25\n    fooUF.Left = exApp.Left + 25\n\n    fooUF.Show\n\n    Set fooUF = Nothing\n\nEnd Sub\n

\n\n

Visio 中的代码：

\n\n

Option Explicit\n\nSub openFooUserForm()\n\n    Dim fooUF As FooUserForm\n    Set fooUF = New FooUserForm\n\n    Dim vsApp As Visio.Application\n    Set vsApp = ThisDocument.Application\n\n    fooUF.StartUpPosition = 0\n    fooUF.Top = vsApp.Top + 25\n    fooUF.Left = vsApp.Left + 25\n\n    fooUF.Show\n\n    Set fooUF = Nothing\n\nEnd Sub\n

\n

Answer 1

由于我假设在许多其他项目中使用它，因此我创建了一个包含所有代码的类。该类目前可以在 32 位中运行，主要是因为我找不到从 Visio 应用程序对象获取 64 位句柄的方法。

由于使用了类型，代码本身是 64 位的LongPtr。更多信息： https: //codekabinett.com/rdumps.php? Lang=2&targetDoc=windows-api-declaration-vba-64-bit
=2&targetDoc=windows-api-declaration-vba-64-bit 这些声明应该有效，因为它们是在 64 位环境中重新创建的。

该类公开 13 个属性，其中 12 个是窗口位置和大小，一个是句柄，这允许用户定位不同的窗口而不是应用程序。这可用于相对于“主”应用程序内打开的窗口定位用户窗体。

Office UserForms（由于某种原因）使用点而不是像素在屏幕上定位自己，为了帮助实现这一点，我还在类中构建了一个转换。

还有一些事情我想改变，比如添加适当的错误处理，也许给类一个默认实例，但现在这是可用的。

资源

http://officeoneonline.com/vba/positioning_using_pixels.html

http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position

解释

这个模块/类中会发生什么？

• 该类处理与 Windows API 的交互
• 它创建一个Private Type Rect由函数使用的GetWindowRect。
• 它声明了GetWindowRect函数，它获取窗口的窗口句柄（显然）并返回“轮廓”的位置（以像素为单位）
• 当对象初始化时，它会自动存储调用它的应用程序的窗口句柄this.Handle
• 当获取其中一个px__属性时，它只是更新窗口位置this.rc并返回所需的值。
• 当获取属性时pt__，它会更新窗口位置并计算以点为单位的等效值，这非常有用，因为 VBA 用户窗体实际上使用点进行定位。此处描述了该转换。
• 可以通过设置属性来更改窗口句柄Handle，这提供了更多灵活性，例如当打开同一应用程序的多个窗口时。

代码

a模块（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

窗口定位器（类）

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