VBA-Beispiel 143
mail schreiben
mail schreiben

Buttons für ein dynamicMenu per VBA erstellen

Im Beispiel wird ein dynamicMenu-Element zur Laufzeit per VBA mit Buttons befüllt. Für jede Tabelle der Exceldatei wird ein Button im dynamicMenu erstellt.

Neben ID, Label usw. bekommt jeder Button auch das onAction-Attribut.
Im Beispiel wird damit die Sub "halligalli" gestartet, sobald auf einen der Buttons geklickt wird.

Die Buttons für ausgeblendete Tabellen bekommen außerdem noch die Attribute screentip, supertip und imageMso.

Bei jedem Blattwechsel wird das dynamicMenu neu erstellt (ausgelöst durch "Workbook_SheetActivate" im Modul "DieseArbeitsmappe" und dann durchgeführt von "dynTabMenu_getContent" in Modul "modRibbon").
Änderungen wie Umbenennen, Einfügen oder Entfernen einer Tabelle, wirken sich dadurch auch auf das Menü aus.

Die Prozeduren Workbook_SheetActivate und OnLoad(ribbon As IRibbonUI) sind in der Downloaddatei aber nicht auf der Webseite.
Private Sub dynTabMenu_getContent(control As IRibbonControl, _
                                  ByRef returnedVal)
Dim strXML As String, strLabel As String, strTag As String
Dim wks As Worksheet
'---------------------------------------
'Für jede Tabelle einen Button einfügen:
'---------------------------------------
On Error GoTo Fehler
  strXML = _
  "<menu xmlns=""http://schemas.microsoft.com/office/2006/01/customui"">"

  For Each wks In ThisWorkbook.Worksheets
    strTag = Mask(wks.Name, False)
    strLabel = Mask(wks.Name, True)

    If wks.Visible = True Then
      strXML = strXML & "<button id=""cmbTab" & wks.Index & """" _
                             & " label=""" & strLabel & """" _
                             & " tag=""" & strTag & """" _
                             & " onAction=""halligalli""/>" & vbLf
    Else
      strXML = strXML & "<button id=""cmbTab" & wks.Index & """" _
                             & " label=""" & strLabel & """" _
                             & " tag=""" & strTag & """" _
                             & " screentip=""mein kleiner Screentip""" _
                             & " supertip=""Tabelle nicht sichtbar!""" _
                             & " imageMso=""StopLeftToRight""" _
                             & " onAction=""halligalli""/>" & vbLf
    End If
  Next wks

  strXML = strXML & "</menu>"
  returnedVal = strXML  'Menü abschicken
  'Debug.Print strXML
Exit Sub

Fehler:
  MsgBox "Fehler in: dynTabMenu_getContent" & vbLf & _
         Err.Description, vbCritical, "Fehler!"
End Sub

Private Function Mask(ByVal str As String, _ ByVal bolLabel As Boolean) As String '--------------------------------------------------------- 'Im Tabellennamen erlaubte Sonderzeichen für XML maskieren '--------------------------------------------------------- On Error GoTo Fehler Mask = IIf(bolLabel, Replace(str, "&", "&&"), _ Replace(str, "&", "&")) Mask = Replace(Mask, """", """) Mask = Replace(Mask, "<", "<") Mask = Replace(Mask, ">", ">") Exit Function Fehler: MsgBox "Fehler in: Function Mask" & vbLf & _ Err.Description, vbCritical, "Fehler!" End Function
Private Sub halligalli(control As IRibbonControl) '--------------------------------------------------------- 'Die Prozedur wird aufgerufen, wenn der Anwender auf einen 'der eben (per VBA) erstellten Buttons klickt. '--------------------------------------------------------- On Error GoTo Fehler If ThisWorkbook.Worksheets(control.Tag).Visible = True Then ThisWorkbook.Worksheets(control.Tag).Activate Else MsgBox "Tabelle wird nicht angezeigt!", vbInformation, "" End If 'MsgBox control.Tag Exit Sub Fehler: MsgBox "Upps...", vbCritical, "" End Sub

Download:   vba143.zip