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

Question

我想编写一个简单的 Excel 宏，为用户调用“添加数字签名”对话框。我不想添加签名本身，只是为了显示“添加数字签名”对话框，以便用户不必自己寻找它。我在谷歌上搜索解决方案，并了解到这无法在原生 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，您可以手动搜索每个命令栏的每个控件 collection 以查找带有 Caption 的控件，这就是您要查找的控件。您最好使用 Like 运算符进行通配符搜索，因为您可能不知道控件标题的确切大小写和方便键盘 short-cuts.[=16 的 & 的位置=]

您可以尝试这样的操作：

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 中调用添加数字签名对话框

How to invoke Add a Digital Signature dialog in Excel VBA

windows

shell

excel

vba

digital-signature