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。代码中注释中的附加信息。

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部分来解决这个问题......但在这种情况下，为什么不制作单独的代码模块呢？

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

4 个答案: