ディレクトリからPowerPointを開き、マクロを再開

Question

サブ内の関数を使用して特定のフォルダからPPTXを開こうとしています。関数の目的は、残りのマクロのコードで実行するファイルを選択することです（基本的にActivePresentationにする）。問題は、PickDir（）関数を呼び出してファイルのパスを取得して開くときに、マクロ実行を停止します。だから、私はただのプレゼンテーションをして、私がやりたいアクションを実行していない。

問題はすべての変数がDim'dされた後約5行で発生します。

Sub ExtractImagesFromPres() 
On Error GoTo ErrorExtract 
Dim oSldSource As Slide 
Dim oShpSource As Shape 
Dim ImgCtr As Integer 
Dim SldCtr As Integer 
Dim ShapeNameArray() As String 
Dim oPP As Object 
Dim SrcDir As String 
Dim SrcFile As String 
'File naming variables 
Dim PPLongLanguageCode As String 
Dim PPShortLanguageCode As String 
Dim FNShort As String 
Dim FNLong As String 
Dim PPLanguageParts1() As String 
Dim PPLanguageParts2() As String 
Dim FNLanguageParts() As String 

SrcDir = PickDir()  'call the PickDir() function to choose a directory to work from 
If SrcDir = "" Then Exit Sub 

SrcFile = SrcDir & "\" & Dir(SrcDir + "\*.pptx") 'complete directory path of ppt to be split 

Set oPP = CreateObject("Powerpoint.Application")  'open ppt containing slides with images/text to be exported 
ActivePresentation = oPP.Presentations.Open(SrcFile, False, False, True) 

ImgCtr = 0 'Image and Slide counter for error messages 
SldCtr = 1 

ReDim ShapeNameArray(1 To 1) As String 'initialize ShapeNameArray to avoid null array errors 

For Each oSldSource In ActivePresentation.Slides 
    For Each oShpSource In oSldSource.Shapes 'loop each shape within each slide 
     If oShpSource.Type <> msoPlaceholder Then 'if shape is not filename placeholder then add it's name to ShapeNameArray 
      ShapeNameArray(UBound(ShapeNameArray)) = oShpSource.Name 
      ReDim Preserve ShapeNameArray(1 To UBound(ShapeNameArray) + 1) As String 'need to add one to array for new shape name 
      ElseIf oShpSource.Type = msoPlaceholder Then 'is shape is filename placeholder then check to see if not empty 
       If oShpSource.TextFrame.TextRange.Length = 0 Then 
        MsgBox "The filename is missing on Slide:" & SldCtr & vbNewLine & _ 
        "Please enter the correct filname and re-run this macro" 
        Exit Sub 
       End If 
       PPLanguageParts1 = Split(ActivePresentation.Name, ".") 'extract language code from PowerPoint filename 
       PPLongLanguageCode = PPLanguageParts1(LBound(PPLanguageParts1)) 
       PPLanguageParts2 = Split(PPLongLanguageCode, "_") 
       PPShortLanguageCode = PPLanguageParts2(UBound(PPLanguageParts2)) 
       FNLanguageParts = Split(oShpSource.TextFrame.TextRange.Text, "_") 'insert PowerPoint filename language code into image filename language code 
       FNShort = FNLanguageParts(LBound(FNLanguageParts)) 
       FNLong = FNShort & "_" & PPShortLanguageCode 
       oShpSource.TextFrame.TextRange.Text = FNLong 

     End If 
    Next oShpSource 
     ReDim Preserve ShapeNameArray(1 To UBound(ShapeNameArray) - 1) As String 'ShapeNameArray has one too many elements, so subtract one 
     Call oSldSource.Shapes.Range(ShapeNameArray).Export(FNLong & ".jpg", ppShapeFormatJPG) 'export images with proper filenames 
     ReDim ShapeNameArray(1 To 1) As String 
     ImgCtr = ImgCtr + 1 
     SldCtr = SldCtr + 1 
Next oSldSource 

If ImgCtr = 0 Then 'error message if no images 
    MsgBox "There were no images found in this presentation", _ 
      vbInformation, "Image extraction failed." 
End If 
Exit Sub 
ErrorExtract: 

If Err.Number <> 0 Then 'error message log 
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number 
End If 
End Sub 

Private Function PickDir() As String 
Dim FD As FileDialog 

    PickDir = "" 

    Set FD = Application.FileDialog(msoFileDialogFolderPicker)  'initialize default MS directory picker 
    With FD 
     .Title = "Pick the folder where your files are located"  'title for directory picker dialog box 
     .AllowMultiSelect = False 
     .Show 
     If .SelectedItems.Count <> 0 Then 
      PickDir = .SelectedItems(1) 
     End If 
    End With 

Answer 1

これはPowerpoint内で実行していますか？はいの場合、別のApplicationオブジェクトを作成する必要はありません.pptを直接開くことができます。そして、あなたはプレゼンテーション（というよりも「ActivePresentationの」を使用して）への参照を取得するために）オープン（からの戻り値を使用することができます

Dim ppt as Presentation 
Set ppt = Application.Presentations.Open(SrcFile, False, False, True) 
'do stuff with ppt 

Answer 2

この行は、おそらくあなたにいくつかのトラブルを与えている：

ActivePresentation = oPP.Presentations.Open(SrcFile, False, False, True) 

私はPPTでウィンドウをアクティブにする方法がわからないが、非常に少なくとも、あなたは以下を使用する必要があります：

Set ActivePresentation = oPP.Presentations.Open(SrcFile, False, False, True) 

プレゼンテーションを有効にするには、Windowsのコレクションなどにアクセスする必要がありますか？うまくいけば、あなたの考えを得るための提案。

application.Presentations(1).Windows(1).Activate 

最後に、あなたが実際にあなたがいない他のプレゼンテーションを開いている場合は、目に見える、それを開くと、あなたが開いているものは非常に可能性が、デフォルトでアクティブ1になり、プレゼンテーションをアクティブにする必要はありません。あなたがパワーポイントアプリケーションオブジェクトを作成している場合、これが当てはまると思います。

oPP.Presentations.Open(SrcFile, False, False, True) 
debug.print oPP.ActivePresentation.Name 

編集：これが正しいなら、あなたは単純に次のことを行う必要があり

Dim oPP as Powerpoint.Application 

を次に際に次のように私もPowerPoint Object Libraryへの参照を設定し、OPPを宣言お勧めしますアプリケーションのインスタンスを作成します。

Set oPP = New Powerpoint.Application 

Answer 3

プレゼンテーションがアクティブであるかを心配する必要はしたくない場合は、行うことができます。

Dim oPres as Presentation 
Set oPres = oPP.Presentations.Open(SrcFile, False, False, True) 

は、その後、コードの残りの部分では、代わりにActivePresentationの私は答えた