如何用vba把excel菜单命令栏的控件FaceId图形提取到单元格中?

在excel中,菜单栏内的控件可以有多种类型,但是只有命令按钮控件(msoControlButton)才有控件图形(Face)匹配。

每个图形都有对应的FaceId 属性,如果需要显示所有的命令按钮控件对应的Face图形到单元格中,可以使用如下的代码:

Sub QQ1722187970()
    Excel.Application.ScreenUpdating = False
    Dim oCB As CommandBar
    Dim oCBC As CommandBarControl
    Dim oWK As Worksheet
    Set oWK = ActiveSheet
    oWK.Cells.Clear
    Dim arr
    Dim iCol As Integer
    arr = VBA.Array("菜单英文名称", "菜单中文名称", "菜单内的控件ID", "菜单内的控件标题", "菜单内的控件FaceID", "菜单内的控件图形")
    iCol = UBound(arr) + 1
    oWK.Range("a1").Resize(1, iCol) = arr
    i = 2
    For Each oCB In Excel.Application.CommandBars
        '遍历每个菜单栏
        With oCB
            '重置菜单栏
            .Reset
            For Each oCBC In .Controls
                '遍历每个控件
                sCBName = .Name
                sCBNameLocal = .NameLocal
                With oCBC
                    '控件id
                    sID = .ID
                    '控件标题
                    sCBCName = .Caption
                    '控件类型
                    iType = .Type
                End With
                '如果是msoControlButton类型的按钮就有Face图形
                If iType = 1 Then
                    iFaceID = oCBC.FaceId
                    With oWK
                        .Cells(i, 1) = sCBName
                        .Cells(i, 2) = sCBNameLocal
                        .Cells(i, 3) = sID
                        .Cells(i, 4) = sCBCName
                        .Cells(i, 5) = iFaceID
                        '把图片复制到剪贴板
                        oCBC.CopyFace
                        '将图片粘贴到单元格中
                        .Paste .Cells(i, 6)
 .OnAction = "'xyf " & .FaceId & "'"
                        i = i + 1
                    End With
                End If
            Next
        End With
    Next
    oWK.Columns.AutoFit
    Excel.Application.ScreenUpdating = True
End Sub

Sub xyf(ByVal iid As Long)
Dim oCBB As CommandBarButton
Set oCBB = Excel.CommandBars.FindControl(ID:=iid)
With oCBB
MsgBox .Caption
MsgBox .FaceId
End With
End Sub

       

发表评论