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

Question

简介:

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

如果我在 Visio(代码块 2)中尝试相同的操作，我会遇到以下问题:
Visio 应用程序的应用程序对象 ( vsApp ) 不支持 .Top一个 .Left属性，所以显然我得到了标准 Run.time error "438": “Object doesn't support this property or method”
问题:

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

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

代码:

在这两种情况下，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

Answer 1

由于我假设在许多其他项目中使用它，我创建了一个包含所有代码的类。该类目前在 32 位中工作，主要是因为我找不到从 Visio 应用程序对象获取 64 位句柄的方法。
由于使用了 LongPtr，代码本身是 64 位的。类型。更多信息:https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
声明应该可以工作，因为它们是在 64 位环境中重新创建的。
该类公开了 13 个属性，其中 12 个是窗口位置和大小，一个是句柄，这允许用户定位不同的窗口而不是应用程序。这可用于相对于“主”应用程序内打开的窗口定位用户窗体。
Office 用户窗体(出于某种原因)使用点而不是像素来将自己定位在屏幕上，为了帮助解决这个问题，我还在类中构建了一个转换。
还有一些我想要改变的东西，比如添加正确的错误处理，也许给类一个默认实例，但现在这是可用的。

资源
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 用户窗体实际上使用点进行定位。转换描述here .

可以通过设置 Handle 来更改窗口句柄。属性，这提供了更多的灵 active ，例如当打开同一应用程序的多个窗口时。

代码
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

窗口定位器(类)

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