Question

我想编写一个简单的Excel宏，为用户调用Add Digital Signature对话框。我不想添加签名本身，只是为了显示添加数字签名对话框，以便用户不必自己查找。我正在谷歌搜索解决方案，并了解这不能在本机Excel VBA中完成。一个人必须直接调用Windows Shell。我该怎么做？

Answer 1

您没有说明您的Excel版本，但假设您有一个带有功能区UI的版本。有几个选项 - 您可以使用流畅的UI控件标识符和此代码：

Option Explicit

Sub FindControlByFluentUIId()

    Dim objCtrl As CommandBarControl
    Dim lngId As Long

    On Error GoTo ErrHandler

    ' magic number of Add Digital Signature
    lngId = 13035
    ' find that control in the command bars collection
    ' this line throws an error for some workbooks !?
    Set obj = Application.CommandBars.FindControl(Office.MsoControlType.msoControlButton, lngId)
    ' execute
    If Not obj Is Nothing Then
        obj.Execute
    Else
        MsgBox "Not found"
    End If

    End Sub

ErrHandler:
    If Err.Number <> 0 Then
        Debug.Print Err.Description
    End If

End Sub

完整的代码列表位于：https://www.microsoft.com/en-us/download/details.aspx?id=36798

如果由于某种原因您不知道ID，您可以手动搜索每个命令栏的每个控件集合，以获得Caption的控件，这就像您正在寻找的那个。您最好使用Like运算符进行通配符搜索，因为您可能不知道控件标题的确切大小和&的位置，以便于键盘快捷方式。

您可以尝试这样的事情：

Option Explicit

Sub TestFindControl()

    Dim strCaptionWild As String
    Dim objCtrl As CommandBarControl

    ' use wildcards to help find the control
    strCaptionWild = "*add*a*digital*signature*"

    ' call the function to find by caption
    Set objCtrl = FindControl(strCaptionWild)

    ' execute on match
    If Not objCtrl Is Nothing Then
        Debug.Print "Command bar index: " & objCtrl.Parent.Index
        Debug.Print "Control index: " & objCtrl.Index
        Debug.Print "Real caption: " & objCtrl.Caption
        objCtrl.Execute
    Else
        MsgBox "Not found for caption: " & strCaptionWild
    End If

End Sub

Function FindControl(ByVal strCaption As String) As CommandBarControl

    Dim objCb As CommandBar
    Dim objCtrl As CommandBarControl
    Dim blnFound As Boolean

    On Error GoTo ErrHandler

    ' not found the control
    blnFound = False

    ' iterate command bars and their controls
    For Each objCb In Application.CommandBars
        For Each objCtrl In objCb.Controls
            ' use like operator check control caption vs input caption
            ' LIKE enables use of wildcard matching
            If LCase$(objCtrl.Caption) Like LCase$(strCaption) Then
                ' found it
                blnFound = True
                Exit For
            End If
        Next objCtrl
        If blnFound Then Exit For
    Next objCb

    Set FindControl = objCtrl

    Exit Function

ErrHandler:
    Debug.Print Err.Description
    Set FindControl = Nothing

End Function

如何在Excel VBA中调用“添加数字签名”对话框

1 个答案: