Code Snippet "VBA Frontpage"

Erweiterung des Kontextmenus zur Formatierung mit ..

Bedingt Prozedur zur Erweiterung des Kontextmenüs und Erstellung eines Klassenmoduls für die Ereignisprozeduren

'Am Anfang des Standardmoduls verweist man mit folgender Deklaration
'auf das neu erzeugte Klassenmodul
Dim objCmdBarEvents As New CmdBarEvents 'Eventhandler für erweitertes Kontextmenü


'Im Standardmodul wird folgender Code zur Erstellung von 4 Kontextmenü-Einträgen angehängt
Sub KontextmenuErweitern()
  Dim ctlContextMenuCode As Office.CommandBarButton
  Dim ctlContextMenuEntries As Office.CommandBarButton
  Dim ctlContextMenuMenu As Office.CommandBarButton
  Dim ctlContextMenuSmall As Office.CommandBarButton

  Const INT_STANDARDKONTEXTMENU = 44
  
  'Standard-Kontextmenü zurücksetzen
  Application.CommandBars(INT_STANDARDKONTEXTMENU).Reset
  
  'Menü CSS Code einfügen
  Set ctlContextMenuCode = Application.CommandBars(INT_STANDARDKONTEXTMENU).Controls.Add
  ctlContextMenuCode.BeginGroup = True
  ctlContextMenuCode.Caption = "CSS Code"
  ctlContextMenuCode.Tag = "cssCode"
  Set objCmdBarEvents.ctrlContextMenuCode = ctlContextMenuCode

  'Menü CSS Entries einfügen
  Set ctlContextMenuEntries = Application.CommandBars(INT_STANDARDKONTEXTMENU).Controls.Add
  ctlContextMenuEntries.Caption = "CSS Entries"
  ctlContextMenuEntries.Tag = "cssCode"
  Set objCmdBarEvents.ctrlContextMenuEntries = ctlContextMenuEntries

  'Menü CSS Menu einfügen
  Set ctlContextMenuMenu = Application.CommandBars(INT_STANDARDKONTEXTMENU).Controls.Add
  ctlContextMenuMenu.Caption = "CSS Menu"
  ctlContextMenuMenu.Tag = "cssMenu"
  Set objCmdBarEvents.ctrlContextMenuMenu = ctlContextMenuMenu

  'Menü CSS Small einfügen
  Set ctlContextMenuSmall = Application.CommandBars(INT_STANDARDKONTEXTMENU).Controls.Add
  ctlContextMenuSmall.Caption = "CSS Small"
  ctlContextMenuCode.Tag = "cssSmall"
  Set objCmdBarEvents.ctrlContextMenuSmall = ctlContextMenuSmall
End Sub


'Ein neu erzeugtes Klassenmodul namens CmdBarEvents enthält folgende Ereignisbehandlungsroutinen
Public WithEvents ctrlContextMenuCode As Office.CommandBarButton
Public WithEvents ctrlContextMenuEntries As Office.CommandBarButton
Public WithEvents ctrlContextMenuMenu As Office.CommandBarButton
Public WithEvents ctrlContextMenuSmall As Office.CommandBarButton

Private Sub ctrlContextMenuCode_Click(ByVal Ctrl As Office.CommandBarButton, _
  CancelDefault As Boolean)
  Call insertCSSSpanClass("code")
End Sub

Private Sub ctrlContextMenuEntries_Click(ByVal Ctrl As Office.CommandBarButton, _
  CancelDefault As Boolean)
  Call insertCSSSpanClass("entries")
End Sub

Private Sub ctrlContextMenuMenu_Click(ByVal Ctrl As Office.CommandBarButton, _
  CancelDefault As Boolean)
  Call insertCSSSpanClass("menu")
End Sub

Private Sub ctrlContextMenuSmall_Click(ByVal Ctrl As Office.CommandBarButton, _
  CancelDefault As Boolean)
  Call insertCSSSpanClass("small")
End Sub


'Im Standardmodul muss sich noch die folgende aufgerufene Prozedur befinden
Sub insertCSSSpanClass(ByVal strClassname As String)
    Dim oIHTMLTxtRange As IHTMLTxtRange

    Set oIHTMLTxtRange = ActiveDocument.Selection.createRange
    oIHTMLTxtRange.pasteHTML ("<span class=""" & strClassname & """>" & _
        oIHTMLTxtRange.htmlText & "</span>")
End Sub