如何编写适用于多个 Office 应用程序的 VBA 代码

Question

我想编写一个适用于三个主要 Office 应用程序（Excel、PowerPoint、Word）的 VBA 代码模块。

由于每个应用程序中的对象模型不同，如果我在 Excel VBE 中编写特定于 PowerPoint 的代码，项目将无法编译。首先要走的路似乎是使用条件编译器常量。但这仍然会导致 VBE 吐出错误，具体取决于 VBE 当前托管在哪个 MSO 应用程序中。

在下面的简化示例中，我想将图片添加到工作表、幻灯片或文档中，具体取决于运行 VBA 代码的应用程序。如果我尝试在 Excel 中编译它，PowerPoint 代码将无法编译（即使它在条件编译器 If...Then 语句中！），反之亦然。如何在不添加对其他 MSO 应用程序的引用的情况下解决此问题（因为这会在分发到不同的 MSO 版本时导致兼容性问题）？

编译器继续查看应该被条件编译器常量有效“注释掉”的代码的方式是非常奇怪/烦人的行为！

' Set the compiler constant depending on which MSO app is hosting the VBE
' before saving as the respective .ppam/.xlam/.dotm add-in
#Const APP = "EXL"

Option Explicit

Dim curSlide As Integer
Dim curSheet As Integer

Public Sub InsertPicture()
    Dim oShp as Shape
    #If APP = "PPT" Then
        ' Do PowerPoint stuff
        ' The next 2 lines will throw "Invalid qualifier" and
        ' "Variable not defined" errors respectively when compiling in Excel.
        curSlide = ActiveWindow.View.Slide.SlideIndex
        Set oShp = ActivePresentation.Slides(curSlide).Shapes.AddPicture & _
            (filename, msoFalse, msoTrue, 0, 0)
    #ElseIf APP = "EXL" Then
        ' Do Excel stuff
        curSheet = ActiveWindow.ActiveSheet
        Set oShp = ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)
    #ElseIf APP = "WRD" Then
        ' Do Word stuff
    #End If
End Sub

由于我无法回答自己的问题：

扩展您的 KazJaw 想法，我认为这样的事情可能会起作用，用 GetObject 替换 CreateObject 函数（因为该实例已经存在，因为该过程是从加载项中调用的）：

' CONDITIONAL COMPILER CONSTANTS
' Set this value before saving to .ppam, .xlam or .dotm
#Const APP = "EXL" ' Allowed Values : PPT, EXL or WRD

Sub One_Sub_For_Word_Excel_PP(filename As String, Optional SlideIndex as Integer)
    #If APP = "PPT" Then
        Dim appPPP As Object
        Set appPPT = GetObject(, "PowerPoint.Application")
        appPPT.ActivePresentation.Slides(SlideIndex).Shapes.AddPicture & _
            (filename,msoFalse,msoTrue,0,0)
    #ElseIf APP = "EXL" Then
        Dim appEXL As Object
        Set appEXL = GetObject(, "Excel.Application")
        appEXL.ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)
    #ElseIf APP = "WRD" Then
        Dim appWRD As Object
        Set appWRD = GetObject(, "Word.Application")
        appWRD.ActiveDocument.AddPicture(filename, msoFalse, msoTrue, 0, 0)
    #End If
End Sub

Answer 1

你可以试试：

Public AppName as String
Public App as Object
Sub One_Sub_For_Word_Excel_PP(filename As String, Optional SlideIndex as Integer)
    AppName = Application.Name
    Set App = Application
    Select Case AppName
        Case "Microsoft PowerPoint"
            App.ActivePresentation.Slides(SlideIndex).Shapes.AddPicture & _
                (filename,msoFalse,msoTrue,0,0)

        Case "Microsoft Excel"
            App.ActiveSheet.AddPicture(filename, msoFalse, msoTrue, 0, 0)

        Case "Microsoft Word"
            App.ActiveDocument.AddPicture(filename, msoFalse, msoTrue, 0, 0)

      End Select
End Sub

或者，编写一个 COM 插件。

Answer 2

正如我在评论中所说 - 我无法想象我想使用您尝试准备的解决方案的情况。但是，即使您设置了很多限制（包括不设置对其他应用程序库的引用），也有一种解决方案。请记住，这样的尝试不会有效率，我绝不会推荐这样的东西。

以下测试子程序适用于所有三个应用程序：MS Word、MS PowerPoint、MS Excel。代码内的 cmets 中的附加信息。

Sub One_Sub_For_Word_Excel_PP()

    Dim XLS As Object
    Dim PP As Object
    Dim WRD As Object

    'this will open instances of all application- to avoid any errors
    Set XLS = CreateObject("Excel.Application")
    Set PP = CreateObject("PowerPoint.Application")
    Set WRD = CreateObject("Word.Application")


    'your code here
    'remember- do not use vba constants like msoFalse but use _
     their numeric values instead

    'simple test
    If Application.Name = "Microsoft Excel" Then
        'do things only for excel
        Debug.Print XLS.Name
    ElseIf Application.Name = "Microsoft PowerPoint" Then
        'do things only for PP
        Debug.Print PP.Name
    Else
        'do things only for Word
        Debug.Print WRD.Name
    End If

    Set XLS = Nothing
    Set PP = Nothing
    Set WRD = Nothing
End Sub

Answer 3

不是吗

#Const APP = "EXL"

#If APP = "PPT" Then

等等？

Answer 4

我假设您希望能够在任何支持 VBA 的应用程序中运行相同的代码（但不一定要调用其他应用程序）。所以...

Sub One_Sub_To_Rule_Them_All()
' Modified version of KazJaw's previous post

    Dim oApp As Object
    Set oApp = Application

    Select Case oApp.Name
        Case Is = "Microsoft Excel"
        'do things only for excel

        Case Is = "Microsoft PowerPoint"
        'do things only for PP, eg
           MsgBox oApp.ActivePresentation.Fullname

        Case Is = "Microsoft Word"
        ' do wordthings

        Case Is = "Visio or CorelDraw or Whatever"
        ' do whatever things

        Case Else
            MsgBox "Jumping up and down and waving hands and running around like headless chicken"

    End Select

    Set oApp = Nothing

End Sub

尽管如此，我不会这样做。除了其他反对意见之外，您需要将应用程序视为对象才能编译代码，而当您这样做时，您会抛弃智能感知。不是微不足道的损失。当然，您可以通过在 Word 中开发 Word 部分、在 PPT 中开发 PPT 部分来解决这个问题……但在这种情况下，为什么不制作单独的代码模块呢？