Könnte Jemand Liste Anzeigen der Schaltfläche Face Id in Excel 2010

Den folgenden Sub BarOpen() arbeiten mit Excel 2010, wahrscheinlich auch noch viele andere Versionen auch, und erzeugt in der Registerkarte "Add-Ins" eine eigene, temporäre Symbolleiste mit Dropdown-Menüs zeigen die FaceIDs von 1 .. 5020 in Gruppen von 30 items.

Option Explicit

Const APP_NAME = "FaceIDs (Browser)"

' The number of icons to be displayed in a set.
Const ICON_SET = 30

Sub BarOpen()
  Dim xBar As CommandBar
  Dim xBarPop As CommandBarPopup
  Dim bCreatedNew As Boolean
  Dim n As Integer, m As Integer
  Dim k As Integer

  On Error Resume Next
  ' Try to get a reference to the 'FaceID Browser' toolbar if it exists and delete it:
  Set xBar = CommandBars(APP_NAME)
  On Error GoTo 0
  If Not xBar Is Nothing Then
    xBar.Delete
    Set xBar = Nothing
  End If

  Set xBar = CommandBars.Add(Name:=APP_NAME, Temporary:=True) ', Position:=msoBarLeft
  With xBar
    .Visible = True
    '.Width = 80
    For k = 0 To 4 ' 5 dropdowns, each for about 1000 FaceIDs
      Set xBarPop = .Controls.Add(Type:=msoControlPopup) ', Before:=1
      With xBarPop
        .BeginGroup = True
        If k = 0 Then
          .Caption = "Face IDs " & 1 + 1000 * k & " ... "
        Else
          .Caption = 1 + 1000 * k & " ... "
        End If
        n = 1
        Do
          With .Controls.Add(Type:=msoControlPopup) '34 items * 30 items = 1020 faceIDs
            .Caption = 1000 * k + n & " ... " & 1000 * k + n + ICON_SET - 1
            For m = 0 To ICON_SET - 1
              With .Controls.Add(Type:=msoControlButton) '
                .Caption = "ID=" & 1000 * k + n + m
                .FaceId = 1000 * k + n + m
              End With
            Next m
          End With
          n = n + ICON_SET
        Loop While n < 1000 ' or 1020, some overlapp
      End With
    Next k
  End With 'xBar
End Sub

kurze Skript schreibt zehn (loop-set für 10) FaceID ' s hinzufügen. der Eintrag in die Symbolleiste der Registerkarte "Add-In" und "Benutzerdefinierte Symbolliste löschen" - löschen Sie diesen Eintrag hinzufügen ( markieren und Rechte Maustaste klicken) - arbeiten mit excel 2010/2013

Sub FaceIdsAusgeben()
Dim symb As CommandBar
Dim Icon As CommandBarControl
Dim i As Integer
On Error Resume Next
Set symb = Application.CommandBars.Add _
("Symbole", msoBarFloating)
For i = 1 To 10
Set Icon = symb.Controls.Add(msoControlButton)
Icon.FaceId = i
Icon.TooltipText = i
Debug.Print ("Symbole = " & i)
Next i
symb.Visible = True
End Sub

Geändert Vorherige Antwort zahlreiche Symbolleisten mit Sätzen von 10 icons. Kann den code ändern (Kommentar/un-Kommentar), Anzahl der Symbolleisten (Leistung kann langsam sein, die auf langsameren Maschinen)

Das Letzte Symbol Nummer für Office 2013, die ich finden konnte, war 25424 für OneDrive

Sub FaceIdsOutput()
' ==================================================
' FaceIdsOutput Macro
' ==================================================
' =========================
Dim sym_bar As CommandBar
Dim cmd_bar As CommandBar
' =========================
Dim i_bar As Integer
Dim n_bar_ammt As Integer
Dim i_bar_start As Integer
Dim i_bar_final As Integer
' =========================
Dim icon_ctrl As CommandBarControl
' =========================
Dim i_icon As Integer
Dim n_icon_step As Integer
Dim i_icon_start As Integer
Dim i_icon_final As Integer
' =========================
n_icon_step = 10
' =========================
i_bar_start = 1
n_bar_ammt =  500
' i_bar_start = 501
' n_bar_ammt =  1000
' i_bar_start = 1001
' n_bar_ammt =  1500
' i_bar_start = 1501
' n_bar_ammt =  2000
' i_bar_start = 2001
' n_bar_ammt =  2543
i_bar_final = i_bar_start + n_bar_ammt - 1
' =========================
' delete toolbars
' =========================
For Each cmd_bar In Application.CommandBars
    If InStr(cmd_bar.Name,"Symbol") <> 0 Then
        cmd_bar.Delete
    End If
Next
' =========================
' create toolbars
' =========================
For i_bar = i_bar_start To i_bar_final
    On Error Resume Next
    Set sym_bar = Application.CommandBars.Add _
        ("Symbol" & i_bar, msoBarFloating, Temporary:=True)
    ' =========================
    ' create buttons
    ' =========================
    i_icon_start = (i_bar-1) * n_icon_step + 1
    i_icon_final = i_icon_start + n_icon_step - 1
    For i_icon = i_icon_start To i_icon_final
        Set icon_ctrl = sym_bar.Controls.Add(msoControlButton)
        icon_ctrl.FaceId = i_icon
        icon_ctrl.TooltipText = i_icon
        Debug.Print ("Symbol = " & i_icon)
    Next i_icon
    sym_bar.Visible = True
Next i_bar
End Sub

Sub DeleteFaceIdsToolbar()
' ==================================================
' DeleteFaceIdsToolbar Macro
' ==================================================
Dim cmd_bar As CommandBar
For Each cmd_bar In Application.CommandBars
    If InStr(cmd_bar.Name,"Symbol") <> 0 Then
        cmd_bar.Delete
    End If
Next
End Sub