Aktuelle Seite:
/vba/vbaUFatMacrobutton.htm
Letzte Änderung: 10.03.2009

Getestet unter Word2000Getestet unter WordXPGetestet unter Word2003Getestet unter Word2007  
Beispiel anzeigen
Makro/Datei speichern
Print

Ü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.

Code markieren
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  

 www.chf-online.de/vba/vbaUFatMacrobutton.htm © 2001-11 Christian Freßdorf (Zaphod-Systems)