none
Kontextmenü per VBA, aber wo sind die Icons?

    Frage

  • Hallo Leute,

    in einem Formular zu einem bestimmten Feld möchte ich ein Kontextmenü verwenden. Soweit so gut, das funkioniert.

        
        'Add Kontextmenü für Kopieren
        Dim cbr As Office.CommandBar
        Dim cbc As Office.CommandBarControl
        On Error Resume Next
        CommandBars("cbrKopieren").Delete
        Set cbr = CommandBars.Add("cbrKopieren", msoBarPopup, False, True)
        Set cbc = cbr.Controls.Add(msoControlButton, , , , True)
        With cbc
                .Caption = "Kopieren mit Formatierung"
                .TooltipText = "Kopiert Feldinhalt mit Formatierungen (Leerzeichen etc.)"
                .OnAction = "=SetCopy(0)"
        End With
        Set cbc = cbr.Controls.Add(msoControlButton, , , , True)
        With cbc
                .Caption = "Kopieren ohne Formatierung"
                .TooltipText = "Kopiert Feldinhalt ohne Formatierungen (Leerzeichen etc.)"
                .OnAction = "=SetCopy(1)"
        End With

    Nun möchte ich aber auch noch Icons anzeigen. Das mache ich ja über die ID, also

     Set cbc = cbr.Controls.Add(msoControlButton,21 , , , True)

    Meine Frage ist nun, wie komme ich an eine ID, wenn ich lediglich die imageMSO kenne?

    Also ich möchte z. B. folgendes Icon verwenden: imageMso="CopyOrMoveToSection"
    Diese imageMso habe ich aus den Ribbon Creator 2010 ausgelesen. Ich könnte auch über die Ribbon gehen, aber das ist mir für diesen Fall einfach zu aufwendig. Daher mein Weg über die VBA-Routine.

    Vieleicht hat ja jemand eine Idee, wie das zu bewerkstelligen ist.

    Gruß Ahmed


    Donnerstag, 1. September 2016 10:26

Antworten

  • Hallo Leute,

    ich mache einmal die Ingrid.

    Die Button-ID's (richtigerweise: FaceID) kann man wie folgt ermitteln:

    Gegeben ist folgendes Formular.

    FormButton

    Mit nachfolgendem Code kann man sich jetzt einfach die FaceID's aller Buttons anzeigen lassen.
    Dabei wird immer in 25-Schritten zu 3 Commandbars ausgelesen.

    Option Compare Database
    
    Sub IconsAndIDs()
       Dim cmb As CommandBar, cmb1 As CommandBar, cmb2 As CommandBar
       Dim intFirst As Integer
       Dim intLast As Integer
       Dim i As Integer
       
       ' Allfällig vorhandene Symbolleiste löschen
      Call ClearAll
       ' Anzahl der gewünschten Symbole abfragen
       intFirst = txtvon
       intLast = txtbis
       
       ' Symbolleiste erzeugen
       Set cmb = CommandBars.Add(Name:="ID & Symbole1")
         
          With cmb
             ' Schleife für die gewünschte Anzahl an Symbolen durchlaufen
             For i = intFirst To intLast
               
                ' Die Symbole einfügen
                With .Controls.Add(msoControlButton)
                   .BeginGroup = True
                   .Caption = i
                   .FaceId = i
                   .Style = msoButtonIconAndCaption
                End With
             Next i
    
          ' Symbolleiste anzeigen und deren Höhe festlegen
          .Visible = True
       End With
       
       
       Set cmb = CommandBars.Add(Name:="ID & Symbole2")
         
          intFirst = txtbis + 1
          txtvon = intFirst
          intLast = txtbis
          With cmb
             ' Schleife für die gewünschte Anzahl an Symbolen durchlaufen
             For i = intFirst To intLast
               
                ' Die Symbole einfügen
                With .Controls.Add(msoControlButton)
                   .BeginGroup = True
                   .Caption = i
                   .FaceId = i
                   .Style = msoButtonIconAndCaption
                End With
             Next i
    
          .Visible = True
       End With
       
       Set cmb = CommandBars.Add(Name:="ID & Symbole3")
          intFirst = txtbis + 1
          txtvon = intFirst
          intLast = txtbis
         
         
          With cmb
             ' Schleife für die gewünschte Anzahl an Symbolen durchlaufen
             For i = intFirst To intLast
               
                ' Die Symbole einfügen
                With .Controls.Add(msoControlButton)
                   .BeginGroup = True
                   .Caption = i
                   .FaceId = i
                   .Style = msoButtonIconAndCaption
                End With
       
             Next i
    
          ' Symbolleiste anzeigen und deren Höhe festlegen
          .Visible = True
       End With
       
       Set cmb = Nothing
       
       txtvon.Value = txtvon.Value + txtIntervall.Value
       Me.Recalc
    End Sub
    
    Private Sub ClearAll()
       Dim cmb As CommandBar
       On Error Resume Next
       Set cmb = CommandBars("ID & Symbole1")
       cmb.Delete
       Set cmb = CommandBars("ID & Symbole2")
       cmb.Delete
       Set cmb = CommandBars("ID & Symbole3")
       cmb.Delete
    End Sub
    
    Private Sub cmdButtonBack_Click()
        txtvon = txtvon - (txtIntervall * 6)
        If txtvon <= 1 Then txtvon = 1
        Call IconsAndIDs
    End Sub
    
    Private Sub cmdButtonVor_Click()
        Call IconsAndIDs
    End Sub
    
    Private Sub cmdDelete_Click()
    On Error Resume Next
    
       Call ClearAll
       txtvon = 1
       
    End Sub
    
    Private Sub Form_Current()
        txtvon.Value = 1
        Me.Recalc
    End Sub
    
    


    Das wars. Jetzt einfach Durchklicken, bis man das gewünschte Icon gefunden hat. Die FaceID merken in verwenden.

      Set cbc = cbr.Controls.Add(msoControlButton, , , , True)
        With cbc
                .Caption = "Kopieren ohne Formatierung"
                .FaceID = 316
                .TooltipText = "Kopiert Feldinhalt ohne Formatierungen (Leerzeichen etc.)"
                .OnAction = "=SetCopy(1)"
        End With

    Gruß Ahmed

    P.S.

    Ob das alle Möglichkeiten sind, weiß ich nicht. Auch konnte ich das ursprünglich gewünschte Icon auf die schnelle nicht finden. Aber zumindest ist das schon einmal eine (Teil)Lösung.

    • Als Antwort markiert Ahmed Martens Donnerstag, 1. September 2016 13:12
    Donnerstag, 1. September 2016 12:14