excel照相机的控件ID

tianxianpei

Sub 遍历控件()
    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", "菜单内的控件标题", "菜单内的控件类型")
    iCol = UBound(arr) + 1
    oWK.Range("a1").Resize(1, iCol) = arr
    i = 2
    For Each oCB In Excel.Application.CommandBars
        '遍历每个菜单栏
        With oCB
            For Each oCBC In .Controls
                '遍历每个控件
                sCBName = .Name
                sCBNameLocal = .NameLocal
                With oCBC
                    '控件id
                    sID = .ID
                    '控件标题
                    sCBCName = .Caption
                    '控件类型
                    iType = .Type
                End With
                    With oWK
                        .Cells(i, 1) = sCBName
                        .Cells(i, 2) = sCBNameLocal
                        .Cells(i, 3) = sID
                        .Cells(i, 4) = sCBCName
                        .Cells(i, 5) = iType
                        i = i + 1
                    End With
            Next
        End With
    Next
    oWK.Columns.AutoFit
    Excel.Application.ScreenUpdating = True
End Sub


有没哪个大神知道excel照相机的控件ID的，我想知道他的控件ID以类似下面这种语句来触发他，我用On Error试了一遍，试不太出来
Application.CommandBars.FindControl(ID:=3627).Execute
Application.CommandBars.ExecuteMso ("MacroSecurity")

我用下面自己写的函数虽然实现了照相机功能，但有个问题这样创建的图片如果再进行复制的话，图片名称还是一样，用照相机得到的图片就算再进行复制，复制出来的图片名称也会变更不会重名，这个功能被微软藏得很深，但阻碍不了我对他的幻想，用函数始终不如一句来的方便，求大神赐我ID

Function 单元镜像(Optional ByVal QA, Optional ByVal QB, Optional ByVal QC, Optional ByVal A, Optional ByVal B, Optional ByVal C As Boolean = True, _
                Optional ByVal CA = 65280, Optional ByVal CB = 1.2, Optional ByVal D As Boolean = True, Optional ByVal DA = 16777215, _
                Optional ByVal E As Boolean = True, Optional ByVal F, Optional ByVal G, Optional ByVal QS)

Dim Y As Boolean

If IsMissing(QC) Then
    Y = Application.ScreenUpdating
    If Y Then Application.ScreenUpdating = False
   
    QA.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    QB.Select
    Set QC = ActiveSheet.Pictures.Paste
    单元镜像 = QC.Name
'    单元镜像 = QC.ZOrder
End If

With QC.ShapeRange
    If Not IsMissing(A) Then .Left = .Left + A '左右位置
    If Not IsMissing(B) Then .Top = .Top + B '上下位置
    If C Then .Line.Visible = C: .Line.ForeColor.RGB = CA: .Line.Weight = CB '线框开启
    If D Then .Fill.Visible = D: .Fill.ForeColor.RGB = DA '背景色开启
    .LockAspectRatio = E
    If Not IsMissing(F) Then .Width = .Width + F
    If Not IsMissing(G) Then .Height = .Height + G
    .LockAspectRatio = msoTrue
End With

If Not IsMissing(QS) Then QC.Formula = QS

If Y Then Application.ScreenUpdating = Y

End Function


V = 单元镜像(QA:=[A1:B10], QB:=[E1], A:=1, B:=3, C:=True, CA:=65280, CB:=1.2, D:=True, DA:=16777215, E:=True, F:=1, G:=1, QS:="=表1!H34:O40")
Call 单元镜像(QC:=Selection, A:=1, B:=3, C:=True, CA:=65280, CB:=1.2, D:=True, DA:=16777215, E:=True, F:=1, G:=1, QS:="=H23:L31")

tianxianpei

沉了，顶一下