投稿/コメントを表示します。

エクセルVBA外部連携講座
PowerPoint の主要オブジェクト紹介

たかちゃんさんの投稿

(投稿ID: 4952)

パワーポイントと連携させて英単語帳のようなものを作成するマクロを
書いてみましたので、記念に投稿します！（^o^）

①Presentation1.pptxというファイルを作成（スライドは０枚）し、
　マクロが書かれたエクセルと同じフォルダに入れておく。
②ExceのA列に英単語、B列に和訳が記入されている状態で、マクロを実行。
③PowerPointにて、スライドを１枚作成し、英単語を入力。
　スライドを１枚作成し、和訳を入力。
Excel2019にて動作確認済み。
Sub PowerPointSlideAdd()
    Dim ppApp As PowerPoint.Application
    Dim ppPrt As PowerPoint.Presentation
    Dim ppSld As PowerPoint.Slide
    Dim ppShape As PowerPoint.Shape
    
    'Presentation1.pptxを開く（スライドが０枚の状態）
    Set ppApp = New PowerPoint.Application
    Dim path As String
    path = ThisWorkbook.path & "\Presentation1.pptx"
    ppApp.Visible = True
    Set ppPrt = ppApp.Presentations.Open(Filename:=path, ReadOnly:=msoFalse)
    
    
    
    Dim c As Long    'スライドのカウント用
    Dim gyo As Long  'エクセルのデータ取得用
    
    For gyo = 2 To Range("B" & Rows.Count).End(xlUp).Row
    
        '英単語を入力
        '１番後ろにスライドを追加
        c = ppPrt.Slides.Count
        Set ppSld = ppPrt.Slides.Add(Index:=c + 1, Layout:=ppLayoutBlank)
        '文字を入力する為、シェイプを１つ作成
        ppSld.Shapes.AddShape Type:=msoShapeRectangle, Left:=20, Top:=160, Width:=920, Height:=164
        '作成したシェイプをへ書式を整えて、データを入力
        Set ppShape = ppSld.Shapes(1)
        With ppShape
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            With .TextFrame.TextRange
                .Font.Size = 160
                .Font.Color = vbBlack
                .Font.Name = "ＭＳ ゴシック"
                .Text = Range("A" & gyo).Value
            End With
        End With
        
        
        '日本語の単語を入力
        '一番後ろにスライドを追加
        c = ppPrt.Slides.Count
        Set ppSld = ppPrt.Slides.Add(Index:=c + 1, Layout:=ppLayoutBlank)
        '文字を入力する為、シェイプを１つ作成
        ppSld.Shapes.AddShape Type:=msoShapeRectangle, Left:=20, Top:=160, Width:=920, Height:=164
        '作成したシェイプにエクセルの値を入力
        Set ppShape = ppSld.Shapes(1)
        With ppShape
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            With .TextFrame.TextRange
                .Font.Size = 160
                .Font.Color = vbBlack
                '日本語のフォントを設定するので、NameFarEastを使用
                .Font.NameFarEast = "ＭＳ ゴシック"
                .Text = Range("B" & gyo).Value
            End With
        End With
    
    Next
    
    ppPrt.Save
    ppPrt.Close
    ppApp.Quit
    
    Set ppShape = Nothing
    Set ppSld = Nothing
    Set ppPrt = Nothing
    Set ppApp = Nothing
End Sub

2020/12/22 11:35