Aktuelle Seite:
/vba/vbpformularformatieren3.htm
Letzte Änderung: 25.02.2011

Getestet unter Word2000Getestet unter WordXPGetestet unter Word2003Einschränkungen unter (Word2007)Einschränkungen unter (Word2010)  
VBA-Code verfügbar: ja
Beispiel anzeigen
Makro/Datei speichern
Print

Damit in Word200-Word2003 die Farbauswahl unterhalb der Symbolleistenschaltfläche angezeigt wird (es ist ja eine Userform), bedarf es einiger Tricks. So sollte die Auswahl ja keine Titelleiste besitzen und immer unterhalb der Schaltfläche sein, egal wo die Symbolleiste platziert ist.
Zur Positionierung der Userform werden die Abstände der Schaltfläche vom Bildschirmrand (CommandBars.ActionControl.Top und CommandBars.ActionControl.Left) ermittels und der Userform zugewiesen. Damit die Userform aber auch unterhalb der Schaltfläche angezeigt wird, wird der Abstand zum oberen Bildschirmrand noch mit der Höhe der Symbolleiste addiert.

With frmHidden
' Aktuelle Position des ControlButtons ermitteln und _
  Userform entspr. positionieren  
If (CommandBars.ActionControl.Top) + PixelsToPoints(.Height) > System.VerticalResolution Then
  .Top = PixelsToPoints(System.VerticalResolution) - (.Height)
Else
  .Top = PixelsToPoints(CommandBars.ActionControl.Top) + PixelsToPoints(CommandBars.ActionControl.Parent.Height)
End If
Debug.Print CommandBars.ActionControl.Parent.Name
If (CommandBars.ActionControl.Left) + PixelsToPoints(.Width) > System.HorizontalResolution Then
  .Left = PixelsToPoints(System.HorizontalResolution) - (.Width)
Else
  .Left = PixelsToPoints(CommandBars.ActionControl.Left)
End If
  .Show vbModeless
End With

Die zusätzliche Abfrage überprüft, ob die Userform ggf. über den rechten Bildschirmrand hinausragen würde. In diesem Fall wird die Userform versetzt angezeigt.

Um eine Userform ohne Titelleiste anzuzeigen, muss man auf eine Reihe von APIs zurückgreifen:

Achtung
Im Moment greift diese Abfrage nur auf dem Hauptbildschirm (sofern mehrere Bildschirme verwendet werden). Befindet sich das Word-Fenster auf dem Nebenbildschirm, bleibt die Farbauswahl am Bildschirmrand hängen!

  • FindWindow - zum Auffinden der Userform/des Fensters und Rückliefern des Fenster-Handles
  • GetWindowLong - zum Abrufen von Informationen über das zum Handle gehörenden Fensters
  • SetWindowLong - zum Setzen/Ändern von Attributen des zum Handle gehörenden Fensters
  • DrawMenuBar - zum Neuzeichnen eines Menüs

Neben den API- und Konstanten-Deklarationen reduziert sich der Code zum Entfernen der Titelleiste auf wenige Zeilen:

' Userform ohne Titelleiste darstellen  
    hWndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
    If hWndForm <> 0 Then
        SetWindowLong hWndForm, GWL_STYLE, GetWindowLong(hWndForm, GWL_STYLE) And Not WS_CAPTION
        DrawMenuBar hWndForm
    End If

Solange man sich im Formularfeld bewegt, wird von Word das Ereignis WindowSelectionChange ausgelöst. In diesem Ereignis wird dann das Aktualisieren der Symbolleiste ausgelöst.

Public WithEvents oApp  As Application
Private Sub oApp_WindowSelectionChange(ByVal sel As Selection)  
fkt_aktuel sel
End Sub  

Wird jedoch der Formularschutz aufgehoben, greift das Ereignis nur dann, wenn mit der Maus die Eingabemarke verschoben wird. Leider aber nicht beim Verschieben mit der Tastatur oder bei Tastatureingaben.
Aus diesem Grund verwendet das Add-In einen zusätzlichen Timer (SetTimer und KillTimer-API), der immer dann ausgeführt wird, wenn der Formularschutz aufgehoben wird. Der Timer wird beim Setzen des Formularschutzes wieder ausgeschaltet.

Der gesamte Code zum Aktualisieren der Symbolleiste wertet dann die aktuellen Formatierungsinformationen aus und setzt entsprechend die Werte und Schaltflächen-Status.

Function fkt_aktuel(sel As Selection)  
' Aktualisiert die Status der Schaltflächen  
  Dim bProtect As Boolean
  Const UNDEFINIERT As Long = 9999999
  Dim idx As Integer
  Dim cbar As CommandBar
  Dim ctl1 As CommandBarComboBox
  Set cbar = cbar_MOF(c_Sym)
  If cbar Is Nothing Then Set cbar = cbar_MOF(c_Sym)
  If cbar Is Nothing Then Exit Function  
  TextSelect = sel.Range
If ActiveDocument.ProtectionType = wdAllowOnlyFormFields Then
  Application.ScreenUpdating = False
  ActiveDocument.Unprotect
  bProtect = True
Else
  modTimer.StartTimer
End If
  If fkt_IsFarbauswahl = True Then
    fkt_SetColor sel
  End If
'  
  With Selection.Range.Font
    If CLng(.Bold) <> UNDEFINIERT Then
    modFormat.cbar_CTL("Fett") = CBool(.Bold)
    End If
    modFormat.cbar_CTL("Kursiv") = CBool(.Italic)
    modFormat.cbar_CTL("Unterstrichen") = CBool(.Underline)
    modFormat.cbar_CTL("Hochgestellt") = CBool(.Superscript)
    modFormat.cbar_CTL("Tiefgestellt") = CBool(.Subscript)
    modFormat.cbar_CTL("Kapitälchen") = CBool(.SmallCaps)
    modFormat.cbar_CTL("Verborgen") = CBool(.Hidden)
    Select Case .Parent.ParagraphFormat.Alignment
    Case wdAlignParagraphLeft
      modFormat.cbar_CTL("Linksbündig") = True
      modFormat.cbar_CTL("Blocksatz") = False
      modFormat.cbar_CTL("Zentriert") = False
       modFormat.cbar_CTL("Rechtsbündig") = False
   Case wdAlignParagraphCenter
      modFormat.cbar_CTL("Linksbündig") = False
      modFormat.cbar_CTL("Blocksatz") = False
      modFormat.cbar_CTL("Zentriert") = True
       modFormat.cbar_CTL("Rechtsbündig") = False
    Case wdAlignParagraphRight
      modFormat.cbar_CTL("Linksbündig") = False
      modFormat.cbar_CTL("Blocksatz") = False
      modFormat.cbar_CTL("Zentriert") = False
       modFormat.cbar_CTL("Rechtsbündig") = True
    Case wdAlignParagraphJustify
      modFormat.cbar_CTL("Linksbündig") = False
      modFormat.cbar_CTL("Blocksatz") = True
      modFormat.cbar_CTL("Zentriert") = False
       modFormat.cbar_CTL("Rechtsbündig") = False
    End Select
    Set ctl1 = cbar.FindControl(Tag:="Schriftgrad")
    If CLng(.Size) <> UNDEFINIERT Then
    For idx = 1 To ctl1.ListCount
      If ctl1.List(idx) = .Size Then
        ctl1.ListIndex = idx
        Exit For
      End If
    Next idx
    End If
    Set ctl1 = cbar.FindControl(Tag:="Schriftart")
    If .Name <> "" Then
    For idx = 1 To ctl1.ListCount
      If ctl1.List(idx) = .Name Then
        ctl1.ListIndex = idx
        Exit For
      End If
    Next idx
    End If
  End With
If bProtect = True Then
  ActiveDocument.Protect wdAllowOnlyFormFields, True
  bProtect = False
Else
  modTimer.StopApiTimer
End If
Application.ScreenUpdating = True
On Error GoTo 0
TextSelect.Select
ThisDocument.Saved = True
End Function 

<< Zurück


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