0

3 つの主要な Office アプリ (Excel、PowerPoint、Word) で動作する単一の VBA コード モジュールを作成したいと考えています。

オブジェクト モデルはアプリごとに異なるため、Excel VBE で PowerPoint 固有のコードを記述した場合、プロジェクトはコンパイルされません。最初に行う方法は、条件付きコンパイラ定数を使用することです。ただし、これにより、VBE が現在ホストされている MSO アプリに応じて、VBE がエラーを吐き出す原因となります。

以下の簡単な例では、VBA コードが実行されているアプリに応じて、シート、スライド、またはドキュメントに画像を追加します。Excel でコンパイルしようとすると、(条件付きコンパイラの If...Then ステートメント内にあるにもかかわらず) PowerPoint コードがコンパイルされず、その逆も同様です。他の 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 のアイデアを拡張すると、CreateObject 関数を GetObject に置き換えると、次のようなことがうまくいくと思います (アドイン内からプロシージャが呼び出されるため、インスタンスが既に存在するため)。

' 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

同じコードを任意の 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

それでも、私はこのようにはしません。他の反論とは別に、コードをコンパイルするにはアプリをオブジェクトとして扱う必要があり、それを行うと、IntelliSense が破棄されます。些細な損失ではありません。確かに、Word の部分を Word で開発し、PPT の部分を PPT で開発することで、それを回避できます。

于 2013-10-04T18:39:34.657 に答える