2
www.ChF-Online.de  

Userform neben Makrobutton anzeigen

   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
 Verschiedenes
 Feld-Arbeiten
aktiv aktiv Form-Sachen
 Auflösungs-Erscheinung
 Fenster-Splitter
 Fortschrittliches
 Hyperlinks in Userformen
 Kontextmenü erstellen
 Pflichtfeldprüfung
 Vorgabewerte ändern
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
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  

 Besucher: 1 online  |  61 heute  |  3559 diesen Monat  |  2150906 insgesamt | Seitenaufrufe: 94   Letzte Änderung: 10.03.2009 © 2001-18 Christian Freßdorf
  Glück ist das Maß für die kleine Zeiteinheit im Leben eines Menschen.
Gerhard Uhlenbruck
 powered by phpCMS and PAX