How to write VBA code that works in multiple Office apps - vba

Question

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

Answer 1

You could try:
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
Alternatively, write a COM Add-in.

Answer 2

As I stated in my comment- I can't imagine the situation I would like to use the solution you are trying to prepare. However, there is one solution even you set lot's of limitations (including not setting references to other application libraries). Please keep in mind that such attempt will be not efficient and I would never recommend anything like this.
The following test subroutine works for all three applications: MS Word, MS PowerPoint, MS Excel. Additional information in comments inside the code.
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

Isn't it
#Const APP = "EXL"
#If APP = "PPT" Then
etc.?

Answer 4

I'm assuming that you want the same code to be able to run from within any VBA-enabled app (but not necessarily to invoke other apps). So ...
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
All the same, I wouldn't do it this way. Apart from the other objections, you need to treat the apps as objects in order for the code to compile, and when you do that, you toss out intellisense. Not a trivial loss. Sure, you can get around that by developing the Word part in Word, the PPT part in PPT ... but in that case, why not just make separate code modules?