Question

简介：

当我尝试将Visio-UserForms相对于调用的Visio应用程序窗口放置时遇到了一个问题，因为在其他MS Office应用程序中也是可能的。
通常，我会像在第一个块（Excel）中那样使用调用代码来在与应用程序窗口相对的位置打开UserForm。
此要求的重要属性是$(document).ready(function () { // Load the first 3 list items from another HTML file //$('#myList2').load('externalList.html div.item:lt(3)'); $('#myList2 div.item:lt(3)').show(); $('#showLess').hide(); var items = 8; var shown = 3; $('#loadMore').click(function () { $('#showLess').show(); shown = $('#myList2 div.item:visible').size()+2; if(shown< items) {$('#myList2 div.item:lt('+shown+')').show();} else {$('#myList2 div.item:lt('+items+')').show(); $('#loadMore').hide(); } }); $('#showLess').click(function () { $('#myList2 div.item').not(':lt(3)').hide(); $('#loadMore').show(); $('#showLess').hide(); }); });和.Left，它们返回窗口相对于屏幕的偏移量。

如果我在Visio中尝试相同的操作（代码块2），则会遇到以下问题： Visio应用程序（.Top）的应用程序对象不支持vsApp和.Top属性，因此很明显我得到了标准的.Left

问题：

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

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

代码：

在两种情况下，FooUserForm都是一个简单的UserForm，只有一个按钮，它用Run.time error "438": “Object doesn't support this property or method”隐藏了表单。以下代码位于标准模块中

Excel中的代码

Me.Hide

Visio中的代码：

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

Answer 1

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

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

该类提供13个属性，其中12个是Window的位置和大小，一个是Handle，这使用户可以将另一个窗口而不是应用程序作为目标。这可用于相对于在“主”应用程序内打开的窗口定位用户窗体。

Office UserForms（出于某种原因）使用Point而不是Pixel来在屏幕上定位自己，为此，我还为该类建立了转换。

还有一些我想改变的事情，例如添加适当的错误处理，也许为该类提供默认实例，但是目前这是可用的。

资源

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函数，将（显然）使用窗口的窗口句柄并以 pixels
初始化对象后，它会自动存储在this.Handle中被调用的应用程序的窗口句柄
获得px__属性之一时，它仅更新窗口位置this.rc并返回所需的值。
使用pt__属性时，它会更新窗口位置并计算等效的磅数，这很有用，因为VBA用户窗体实际上使用磅数进行定位。 here描述了该转换。
可以通过设置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

WindowPositioner（类）

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

您只需要在Visio中使用Application.Window.GetWindowRect而不是Application.Top和Application.Left来获取主窗口坐标（由于历史原因-当Visio成为Microsoft Office大约20年的一部分时）以前，此API已经存在，并且与您所指的其他Office应用不同。无论如何，比接受的答案更容易完成主题：

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应用程序的窗口位置

2 个答案: