VBA-Beispiel 012
mail schreiben
mail schreiben

Symbolleiste mit Menüeinträgen erstellen
Nachfolgendes Makro erzeugt die Symbolleiste "Bingo". Diese besteht aus den beiden Hauptmenüeinträgen: "Farbe" und "Zelladresse".
Das Menü "Farbe" hat drei Untermenüs, denen Makros zugewiesen werden. Die Untermenüs von "Farbe" mit den Namen der jeweiligen Makros:

      grün - Makro1
      blau - Makro2
      Farbe weg - Makro3

Das Hauptmenü "Zelladresse" hat nur ein Untermenü (wo steht der Cursor ???). Diesem Untermenü ist Makro4 zugeordnet.

Sub Symbolleiste_erzeugen()
'erzeugt die Symbolleiste "Bingo"
Dim Leiste As CommandBar
Dim Neu As CommandBarControl, Menü As CommandBarControl

On Error GoTo Hell
'Hauptmenüs festlegen
Set Leiste = Application.CommandBars.Add(Name:="Bingo")
With Leiste
    .Visible = True
    .Controls.Add(Type:=msoControlPopup).Caption = "Farbe"
    .Controls.Add(Type:=msoControlPopup).Caption = "Zelladresse"
End With
'Farbe-Untermenü definieren
'Controls(1)= erste Menü in Symbolleiste
Set Menü = CommandBars("Bingo").Controls(1)

Set Neu = Menü.Controls.Add(Type:=msoControlButton, ID:=2949)
With Neu
    .Caption = "grün"
    .OnAction = "Makro1"
End With
Set Neu = Menü.Controls.Add(Type:=msoControlButton, ID:=2949)
With Neu
    .Caption = "blau"
    .OnAction = "Makro2"
End With
Set Neu = Menü.Controls.Add(Type:=msoControlButton, ID:=2949)
With Neu
   'Trennstrich einfügen
    .BeginGroup = True
    .Caption = "Farbe weg"
    .OnAction = "Makro3"
End With

'Zelladresse definieren
'Controls(2)= zweite Menü in Symbolleiste
Set Menü = CommandBars("Bingo").Controls(2)

Set Neu = Menü.Controls.Add(Type:=msoControlButton, ID:=2949)
With Neu
    .Caption = "wo steht der Cursor ???"
    .OnAction = "Makro4"
End With

'Speicher freigeben
Set Leiste = Nothing
Set Menü = Nothing
Set Neu = Nothing
Exit Sub

Hell:
  Set Leiste = Nothing
  Set Menü = Nothing
  Set Neu = Nothing

  MsgBox "sorry, Fehler aufgetreten", vbCritical, ""
End Sub



Sub Makro1()
    Selection.Interior.ColorIndex = 35
End Sub

Sub Makro2()
    Selection.Interior.ColorIndex = 34
End Sub

Sub Makro3()
    Cells.Interior.ColorIndex = xlNone
End Sub

Sub Makro4()
Dim Zelle
    Zelle = ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    MsgBox ("der Cursor steht in Zelle: ") & Zelle
End Sub
Download:   vba012.zip (enthält zwei Beispiele)
relevante Links:

top