[[20160419110920]]　『Excel表をPowerPointスライド一枚一枚に貼るVBA』（さかき）　ページの最後に飛ぶ

『Excel表をPowerPointスライド一枚一枚に貼るVBA』（さかき）

 お世話になります。よろしくお願いします。

 Sheet1に文字が並んだ表があります。例としまして、

 A1に○○計画1
 A2に○○計画2
 A3に今後の展開

 などなど。
これはPowerPointのスライドのサブタイトルになります。
これを既存のPowerPointのスライドにテキストボックスで貼り付けたいと
思っております。

 そのため、以下のページを参考にしました。

 鵜原パソコンソフト研究所 様
http://excel-ubara.com/excelvba5/EXCELVBA254.html

 貼り付けをテキストにして貼り付け位置を変えたりは出来たのですが、
複数スライドにペーストすることが出来ません。

 1セルずつコピーして1スライドずつペーストしていくことはできるのでしょうか？

 ご指導いただけますよう、お願いいたします。

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

Sub sample()

 '★追加変更部分(2007環境)
    Dim ppApp As New PowerPoint.Application
    Dim ppPt As Presentation
    Dim ppSlide As Slide
    Dim ppShape As PowerPoint.Shape
    Dim ws As Worksheet
    Dim rg As Range 'コピー範囲★
    Dim p As Long 'スライド数カウンタ★
    ppApp.Visible = True 'PowerPoint2007以前の場合は有効にしてください。
    Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rg = ws.Range("A1") '★
    With ws
    For p = 1 To ppPt.Slides.Count '★
        rg.Copy '★
            'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。
            'スライド番号を指定
            Set ppSlide = ppPt.Slides(p) '★
            ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse
            Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count)
            '上位置
            ppShape.Top = Application.CentimetersToPoints(1)
            '左位置
            ppShape.Left = Application.CentimetersToPoints(1)
            '縦横比を固定
            ppShape.LockAspectRatio = msoTrue
            '横幅
            ppShape.Width = Application.CentimetersToPoints(30)
            Application.CutCopyMode = False
        Set rg = rg.Offset(1) '★
    Next p '★
    End With
    ppPt.Save
    ppApp.Quit
    Set ppPt = Nothing
    Set ppApp = Nothing
End Sub
（mm） 2016/04/19(火) 16:58

mmさま

 ありがとうございます！無事に出来ました！！

 ppPt.SlidesにCount、自分がやったときは出来なかったです。
きっとどこかを間違って書いていたのですね。

 これで80スライドもあるファイル10個を一つ一つコピペする手間がなくなりました。
本当にありがとうございました。
（さかき） 2016/04/19(火) 17:29

コメント返信：

[ 一覧(最新更新順) ]

[[20160419110920]] 『Excel表をPowerPointスライド一枚一枚に貼るVBA』（さかき） ページの最後に飛ぶ

[[20160419110920]]　『Excel表をPowerPointスライド一枚一枚に貼るVBA』（さかき）　ページの最後に飛ぶ