Über einen MACROBUTTON (Feld) kann man ein Makro aufrufen, wenn auf diese Feld-Schaltfläche geklickt wird. Über dieses Makro lässt sich z.B. auch eine Userform anzeigen, in der entweder weitere Informationen stehen oder Eingaben abgefragt werden können. Je nach Einstellung der Userform wird diese zentriert oder von Windows positioniert. Möchte man die Userform benutzerdefiniert positionieren, muss die Position der Userform mitgegeben werden.
An diese Stelle greift nun nachstehendes Makro ein, indem es die Position des MACROBUTTON-Feldes auf dem Bildschirm ermittelt und diese Koordinaten zum Anzeigen der Userform hinter dem Feld verwendet.
Zur Ermittlung dieser Bildschirminformationen steht die Eigenschaft ActiveWindow.GetPoint zur Verfügung, die genau diese Informationen für ein Range- oder Shape-Objekt ("obj") liefern.
ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, obj
Ein Problem tritt aber auf, wenn nun die linke obere Position der Userform nahe am unteren oder rechten Rand ist und somit die Userform aus dem Bildschirmbereich herausragen würde. Diese Fälle können mit Hilfe der System-Eigenschaften HorizontalResolution und VerticalResolution abgefangen werden, indem geprüft wird, ob die Position der oberen rechten bzw. unteren rechten Ecke der Userform noch im Bildschirmbereich liegt.
If (pLeft) + PointsToPixels(.Width) > (System.HorizontalResolution) Then
Selection.Range.Collapse wdCollapseStart
ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range
.Left = PixelsToPoints(pLeft) - (.Width)
Else
.Left = PixelsToPoints(pLeft)
End If
Die Bildschirmauflösung wird dabei in Pixel angegeben, die Userform-Abmessung aber in Points, so dass diese Angabe mit Hilfe der Funktion PointsToPixels umgerechnet werden muss. Zum Positionieren der Userform muss dann diese Pixel-Angabe mit Hilfe der Funktion PixelsToPoints wieder in Points zurückgerechnet werden.
Option Explicit
Sub Makro()
Dim pLeft As Long
Dim pTop As Long
Dim pWidth As Long
Dim pHeight As Long
Dim rng As Range
Set rng = Selection.Fields(1).Result
ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, _
rng
' Userform laden aber noch nicht anzeigen
Load UserForm1 'Name der Userform
With UserForm1
' Linken Abstand ermitteln
' wenn Userform rechts aus dem Bildschirm herausragt
' nach links an den Feldanfang verschieben
If (pLeft) + PointsToPixels(.Width) > (System.HorizontalResolution) Then
Selection.Range.Collapse wdCollapseStart
ActiveWindow.GetPoint pLeft, pTop, pWidth, pHeight, Selection.Range
.Left = PixelsToPoints(pLeft) - (.Width)
Else
.Left = PixelsToPoints(pLeft)
End If
' Oberen Abstand ermitteln
' wenn Userform unten aus dem Bildschirm herausragt
' nach oben verschieben
If (pTop) + PointsToPixels(.Height) > (System.VerticalResolution) Then
.Top = PixelsToPoints(pTop) - (.Height)
Else
.Top = PixelsToPoints(pTop)
End If
'Userform anzeigen
.Show vbModeless
End With
End Sub
|