[[20150921184703]]　『既存のパワポスライド内に指定フォルダの画像ファ』（help）　ページの最後に飛ぶ

『既存のパワポスライド内に指定フォルダの画像ファイルを1枚ずつ貼りつけたい。』（help）

初めまして。
helpです。

今回は、パワポ内に画像を1枚ずつ貼りつけたい
ということで質問したく投稿しています。

下記のようなVBAは見つけられました。

Public Sub addPhotoParPage()

    Dim i As Integer
    Dim strPath As String

    Dim objFileSystem As Object
    Dim objFolder As Object
    Dim objFile As Object

    strPath = BrowseForFolder()

    If strPath = "" Then
        Exit Sub
    End If

    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFileSystem.GetFolder(strPath)

    i = 0
    For Each objFile In objFolder.Files
        ' スライドの追加
        ActivePresentation.Slides.Add( _
            Index:=ActivePresentation.Slides.Count + 1, _
            Layout:=ppLayoutText).Select
        ' 画像の挿入
        ActiveWindow.Selection.SlideRange.Shapes.AddPicture( _
            FileName:=objFile.Path, _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, _
            Left:=0, _
            Top:=0).Select
        ' 50 回に一回 DoEvents 発生
        i = i + 1
        If i Mod 50 = 0 Then
            DoEvents
        End If
    Next

    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFileSystem = Nothing

End Sub

Private Function BrowseForFolder(Optional varRoot As Variant) As String

    Dim objFolder As Object

    ' フォルダ選択ダイアログを表示
    Set objFolder = CreateObject("Shell.Application").BrowseForFolder( _
                                 0, _
                                 "画像があるフォルダを選択してください", _
                                 &H11, _
                                 varRoot)

    ' 選択内容を取得
    If Not (objFolder Is Nothing) Then
        BrowseForFolder = objFolder.Items.Item.Path
    Else
        BrowseForFolder = ""
    End If

    Set objFolder = Nothing

End Function

しかし、これだと新規でスライドを作成して画像を挿入して貼り付けてしまうため
既存のスライドを使うことができません。

あまりVBAが分からないのでどこをどう変えていいのかも分かりません。

ネット中を2日ほど20時間以上調べたのですが見つかりません。

アドバイスいただけないでしょうか？
よろしくお願いいたします。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

無回答埋め。

ご提示のソースコードは、PPT用マクロであり、ExcelのVBAではありません。
PPTを制御するマクロは作った事が無かった事が無かったのですが、こんな感じかと思います。

 Sub test()
    Const cPATH = "c:\test\"
    Const cPIC = "c:\test\test.png"
    Dim PPT As Object
    Dim cFile As String

    Set PPT = CreateObject("PowerPoint.Application")

    cFile = Dir(cPATH & "*.ppt*")
    While cFile <> ""
        PPT.Presentations.Open cPATH & cFile
        PPT.ActiveWindow.View.GotoSlide (1)
        PPT.ActiveWindow.Selection.SlideRange.Shapes.AddPicture cPIC, msoFalse, msoTrue, 0, 0
        PPT.ActivePresentation.Save
        PPT.ActivePresentation.Close
        cFile = Dir
    Wend
    PPT.Quit
 End Sub
（???） 2015/09/25(金) 11:13

コメント返信：

[ 一覧(最新更新順) ]

[[20150921184703]] 『既存のパワポスライド内に指定フォルダの画像ファ』（help） ページの最後に飛ぶ

[[20150921184703]]　『既存のパワポスライド内に指定フォルダの画像ファ』（help）　ページの最後に飛ぶ