0

I want to write a single VBA code module that works on the three main Office Apps (Excel, PowerPoint, Word).

Because the object models are different in each app, if I write code that's specific for PowerPoint while in the Excel VBE, the project won't compile. The way to go first appears to be to use conditional compiler constants. But this still causes the VBE to spit out errors depending on which MSO app the VBE is currently being hosted in.

In the simplified example below, I want to add a picture to a sheet, slide or document, depending on which app the VBA code is being run from. If I try to compile it in Excel, the PowerPoint code doesn't compile (even though it's within a conditional compiler If...Then statement!) and vice-versa. How does one get round this without adding references to the other MSO apps (as this causes compatibility issues when distributing to different MSO versions)?

The way the compiler continues to look at code that should be effectively "commented out" by the conditional compiler constants is very odd/annoying behaviour!

' 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

Since I'm unable to answer my own question:

Expanding on your idea KazJaw, I think something like this may work, replacing the CreateObject function with GetObject (because the instance will already exist since the procedure is being called from within an add-in):

' 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
4

4 回答 4

2

你可以试试：

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 插件。

于 2013-10-02T14:52:44.777 回答
0

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

以下测试子程序适用于所有三个应用程序：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
于 2013-10-02T11:56:11.287 回答
0

是不是

#Const APP = "EXL"

#If APP = "PPT" Then

ETC。？

于 2013-10-02T13:31:36.283 回答
0

我假设您希望能够在任何支持 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 部分来解决这个问题……但在这种情况下，为什么不制作单独的代码模块呢？

于 2013-10-04T18:39:34.657 回答