Gruppe
Menue
Problem
Wie kann ich dem Formatmenü Menüpunkte zum Hoch-/Tiefstellen der jeweils letzten Zeichen der Werte einer Zellauswahl hinzufügen?
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call CmdDelete
End Sub
Private Sub Workbook_Open()
Dim oBar As CommandBar
Dim oPopUpA As CommandBarPopup
Dim oPopUpB As CommandBarPopup
Dim oBtn As CommandBarButton
Call CmdDelete
Set oBar = Application.CommandBars("Worksheet Menu Bar")
Set oPopUpA = oBar.Controls("Format")
Set oPopUpB = oPopUpA.Controls.Add(Type:=msoControlPopup)
With oPopUpB
.Caption = "&HochTief"
.BeginGroup = True
End With
Set oBtn = oPopUpB.Controls.Add
With oBtn
.Caption = "&Hochstellen"
.OnAction = "HochTiefStellen"
.Style = msoButtonCaption
End With
Set oBtn = oPopUpB.Controls.Add
With oBtn
.Caption = "&Tiefstellen"
.OnAction = "HochTiefStellen"
.Style = msoButtonCaption
End With
Set oBtn = oPopUpB.Controls.Add
With oBtn
.Caption = "&Normal"
.OnAction = "HochTiefStellen"
.Style = msoButtonCaption
End With
End Sub
StandardModule: modMain
Sub HochTiefStellen()
Dim rng As Range
For Each rng In Selection
With rng.Characters(Start:=Len(rng.Text), Length:=1).Font
Select Case Application.Caller(1)
Case 1
.Superscript = True
Case 2
.Subscript = True
Case 3
.Superscript = False
.Subscript = False
End Select
End With
Next rng
End Sub
Sub CmdDelete()
On Error GoTo ERRORHANDLER
Application.CommandBars("Format").Controls("HochTief").Delete
ERRORHANDLER:
End Sub