使用 Visual Basic 将 PDF 插入 Excel

Question

我正在编写一个宏，它允许用户将 PDF 插入到工作表中。问题是不同的人有不同版本的 Adob​​e。此代码适用于我的机器：

ActiveSheet.OLEObjects.Add(ClassType:="Acrobat.Document.DC", Link:=False, DisplayAsIcon:=False).Activate

但是该代码会在其他人的机器上产生错误，因为他需要这个：

ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.DC", Link:=False, DisplayAsIcon:=False).Activate

注意 ClassType 是不同的。有没有办法检查 ClassType 是否存在？我想做这样的事情：

If Exists(ClassType("Acrobat.Document.DC")) Then
     ActiveSheet.OLEObjects.Add(ClassType:="Acrobat.Document.DC", Link:=False, DisplayAsIcon:=False).Activate
Else 
     ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.DC", Link:=False, DisplayAsIcon:=False).Activate
End If

注意：我可以通过使用 On Resume Error Next 来强制执行此操作，但这似乎不是最干净的方法。

Answer 1

On Error Resume Next用于此目的是完全正常的。这是一个例子

Sub Sample()
    Dim objAcrobat As Object
    Dim objAcroExch As Object
    
    On Error Resume Next
    Set objAcrobat = CreateObject("Acrobat.Document.DC")
    Set objAcroExch = CreateObject("AcroExch.Document.DC")
    On Error GoTo 0
    
    If Not objAcrobat Is Nothing Then
        MsgBox "Acrobat found"
    Else
        MsgBox "Acrobat not found"
    End If
    
    If Not objAcroExch Is Nothing Then
        MsgBox "AcroExch found"
    Else
        MsgBox "AcroExch not found"
    End If
End Sub

因为我两者都有，所以我都被“找到”了。

你的用法是这样的

Sub Sample()
    Dim objAcrobat As Object
    Dim objAcroExch As Object
    
    On Error Resume Next
    Set objAcrobat = CreateObject("Acrobat.Document.DC")
    Set objAcroExch = CreateObject("AcroExch.Document.DC")
    On Error GoTo 0
    
    If Not objAcrobat Is Nothing Then
        ActiveSheet.OLEObjects.Add(ClassType:="Acrobat.Document.DC", _
                                   Link:=False, _
                                   DisplayAsIcon:=False).Activate
    ElseIf Not objAcroExch Is Nothing Then
        ActiveSheet.OLEObjects.Add(ClassType:="AcroExch.Document.DC", _
                                   Link:=False, _
                                   DisplayAsIcon:=False).Activate
    Else
       MsgBox "Abobe not installed"
    End If
End Sub