I get the icons for popup menus with two different codes. Why are they different if they have the same FaceID?
Not only the type of icons (one type Excel 2003 and another Excel 365) There are also different icons, as we can be seen in the image.
What code should I use in my popup menu to get the Excel 365 style?
I create my popup menu with this code and I can't get the Excel 365 icon:
With Application.CommandBars.Add(Name:=gsMENUNOTES, _
Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
With .Controls.Add(Type:=msoControlButton)
.Caption = "New note"
.OnAction = "NewNote"
.FaceId = 4385
End With
End With
This is the code to get the icons (Excel 365 type) on the Ribbon (https://stackoverflow.com/a/18364215/11185212)
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
And this is the code to get the icons (Excel 2003 type) on the sheet (https://www.mrexcel.com/board/threads/face-id-in-column-with-their-names-in-excel-sheet-using-vba.567230/)
Option Explicit
Sub exa()
Dim CB As CommandBar
Dim ctl As CommandBarButton
Dim strCBName As String
Dim wbTemp As Workbook
Dim wks As Worksheet
Dim rngInput As Range
Dim i As Long
Application.ScreenUpdating = False
Set wbTemp = Workbooks.Add(xlWBATWorksheet)
wbTemp.SaveAs ThisWorkbook.Path & "\FaceID.xlsx"
Dim NID As Long
Dim NSheet As Long
For NSheet = 1 To 5
'// Add a temp commandbar, make it a popup (which we won't show); add a temp control //
Set CB = CommandBars.Add(Position:=msoBarPopup, MenuBar:=False, Temporary:=True)
Set ctl = CB.Controls.Add(Type:=msoControlButton, Temporary:=True)
strCBName = CB.Name
Set wks = wbTemp.Worksheets(NSheet)
Dim vlFrom As Long
vlFrom = ((NSheet - 1) * 50 * 20) + 1
Dim vlTo As Long
vlTo = NSheet * 50 * 20
wks.Name = "F.ID " & vlFrom & "-" & vlTo
Dim Col As Integer
For Col = 2 To 40 Step 2
Dim LCol As String
LCol = Split(wks.Cells(1, Col).Address, "$")(1)
Set rngInput = wks.Range(LCol & ":" & LCol)
rngInput.Offset(, -1).ColumnWidth = 3
rngInput.ColumnWidth = 8
rngInput.HorizontalAlignment = xlRight
On Error Resume Next
For i = 1 To 50
NID = NID + 1
ctl.FaceId = NID
ctl.CopyFace
rngInput.Cells(i).PasteSpecial
rngInput.Cells(i).Value = NID
Next i
Next Col
'// just so the last image pasted doesn't stay selected//
Application.GoTo wks.Cells(1, 1)
wbTemp.Sheets.Add After:=wbTemp.Sheets(wbTemp.Sheets.Count)
'Debug.Print NSheet
'DoEvents
'// Kill the temp cbar and ctrl //
Set CB = CommandBars(strCBName)
On Error GoTo 0
If Not CB Is Nothing Then
CB.Delete
Else
MsgBox "ACK! I lost a toolbar!", 0, vbNullString
End If
Next NSheet
wbTemp.Save
End Sub
