FaceID Image

[vbano1]

Tra cứu FaceID:
Một số dự án gần đây, chúng ta để ý thấy mọi người đang có xu hướng sử dụng FaceID. Đương nhiên, các bạn có thể google để tra cứu FaceID.
Tuy nhiên nếu như offline không có internet, thì bạn có thể tự tra cứu FaceID bằng VBA dưới đây:

Sub ShowFaceIDs()
    Dim NewToolbar As CommandBar
    Dim TopPos As Long, LeftPos As Long
    Dim i As Long, NumPics As Long
'- ? ? ? ? Change These ? ? ? ? ?
    Const ID_START As Long = 1
    Const ID_END As Long = 500
'- ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ?

'   Delete existing TempFaceIds toolbar if it exists
    On Error Resume Next
    Application.CommandBars("TempFaceIds").Delete
    On Error GoTo 0

'   Clear the sheet
    ActiveSheet.Pictures.Delete
    Application.ScreenUpdating = False
    
'   Add an empty toolbar
    Set NewToolbar = Application.CommandBars.Add _
        (Name:="TempFaceIds")

'   Starting positions
    TopPos = 5
    LeftPos = 5
    NumPics = 0
    
    For i = ID_START To ID_END
        On Error Resume Next
        NewToolbar.Controls(1).Delete
        With NewToolbar.Controls.Add(Type:=msoControlButton)
            .FaceId = i
            .CopyFace
        End With
        On Error GoTo 0
        
        NumPics = NumPics + 1
        ActiveSheet.Paste
        With ActiveSheet.Shapes(NumPics)
            .Top = TopPos
            .Left = LeftPos
            .Name = "FaceID " & i
            .PictureFormat.TransparentBackground = True
            .PictureFormat.TransparencyColor = RGB(224, 223, 227)
        End With
        
'       Update top and left positions for the next one
        LeftPos = LeftPos + 16
        If NumPics Mod 40 = 0 Then
            TopPos = TopPos + 16
            LeftPos = 5
        End If
    Next i
    ActiveWindow.RangeSelection.Select
    Application.CommandBars("TempFaceIds").Delete
End Sub

Kết quả:

Bạn cần đăng nhập để thấy đính kèm

Nguồn tham khảo:

Bạn cần đăng nhập để thấy link

 

[giaiphapvba]

Load FaceID lên Button, hoặc UserForm:

Dim strPictureFile As String

Private Sub ComboBox1_Change()
    Dim oImageIcon As CommandBarControl
    Dim intFaceId As Integer
    strPictureFile = Environ("TEMP") & "\ImageFilename"
    Select Case ComboBox1.ListIndex
        Case 0
            intFaceId = 3
        Case 1
            intFaceId = 19
        Case 2
            intFaceId = 21
        Case 3
            intFaceId = 1643
        Case 4
            intFaceId = 2521
        Case 5
            intFaceId = 210
        Case 6
            intFaceId = 113
        Case 7
            intFaceId = 984
        Case 8
            intFaceId = 445
    End Select
    Set oImageIcon = Application.CommandBars.FindControl(ID:=intFaceId)
    stdole.SavePicture oImageIcon.Picture, strPictureFile
    With CommandButton1
        .Picture = LoadPicture(strPictureFile)
        .Caption = ComboBox1.Value
        .Font.Bold = True
        .SetFocus
    End With
    With UserForm1
        .Picture = LoadPicture(strPictureFile)
    End With
End Sub


Private Sub UserForm_Initialize()
    Dim vIconsArray() As Variant
    vIconsArray = Array _
    ("Save", "Copy", "Cut", "Currency", "Print", "Sort", "Bold", "Help", "Zoom-")
    With ComboBox1
        .List = vIconsArray
        .ListIndex = 0
        .Font.Bold = True
    End With
End Sub

Private Sub UserForm_Terminate()
    Kill strPictureFile
End Sub

Bạn cần đăng nhập để thấy đính kèm

Mình chưa hiểu tại sao lại chưa hoạt động khi FaceId = 445.
File demo:

Bạn cần đăng nhập để thấy link