Excel の１レコードを Power Point で１枚のスライドに一括変換

Excel のデータの１レコードを Power Point のスライド１枚に一括してまとめて変換する方法をご紹介します。
具体的にピンとこないかもしれないので、まずは図説でご説明します。
こんな感じで、Excel に入ったデータを、Power Point のスライドへ自動的に反映させていくことをやっていきます。

 

 

この事例の場合、Excel のデータに、都道府県名と、県庁所在地名、その他の主要都市ということで、１つのレコードに３つのデータが入っています。
これを、１つのレコードを１枚のスライドに、つまり都道府県別にそれぞれ１枚のカードに都道府県名、県庁所在地名、その他の主要都市といった３つのデータが入ったスライドを作っていきます。
Excelでのデータの一行目は、項目名となっていて、実際のデータは２行目以降になっています。

方法としては、

 

●データ形式の確認●
１．データが入った Excel のファイルを開く
２．データの１行目は項目名になっていることを確認する。

 

●Excel 側でのマクロの作成●
３．Power Point を呼び出し、１つのレコードのデータを１つのスライドに書き込むマクロを作る。

 

●Power Point 側でのスライドのカードテンプレートを作成する
４．Excelファイルは開いたまま、Power Point を開く。
５．Power Point に白紙のスライドを作り、それぞれの項目を入れるためのテキストボックスを設置する。
６．この時に、書式・文字の大きさ・色、アニメーションなどを設定しておく。

 

●Excelのマクロを実行する●
７．Power Point は開いたまま、先ほど開いたままにしてあった Excelファイルのマクロを実行する。
８．開いたままにしてあった Power Point を確認すると、１つのレコードのデータが１枚のスライドに反映されている。
９．一番上にある「スライドショー」タグから「最初から」を選択すると、カードをめくるように表示される。

 

※１つのレコードが１枚のスライドに反映されたとき、最初に設定した書式や文字の色、大きさ、アニメーションなどが、すでに反映されています。

英単語とその日本語訳の場合も同様に、作業を進めていきます。
違うのは、項目数が、「英単語」と「日本語訳」の２つしかないので、マクロの中の項目数に該当する部分の数字を、３から２に書き換えればＯＫで、あとの作業は同じです。

 

Excel の１レコードを Power Point で１枚のスライドに一括変換するマクロ

 

マクロのスクリプトを記載しておきます。

 

都道府県名の事例のように１レコードに３項目のデータがある場合

Sub エクセルパワポカード()
Dim ppApp As Object, r As Long, c As Long
Set ppApp = GetObject(, "PowerPoint.Application")
r = 2
Do While Cells(r, 1).Value <> ""
With ppApp
For c = 1 To 3
With .ActiveWindow.View.Slide
.Shapes(c).TextFrame.TextRange.Text = Cells(r, c).Value
End With
Next
With .ActivePresentation
If Cells(r + 1, 1).Value <> "" Then
.Slides(1).Duplicate.MoveTo toPos:=.Slides.Count + 1
End If
End With
.ActiveWindow.View.GotoSlide .ActivePresentation.Slides.Count
End With
r = r + 1
Loop
Set ppApp = Nothing
Application.CutCopyMode = False
End Sub

英単語⇒日本語訳のように１レコードに２項目のデータである場合

Sub エクセルパワポカード()
Dim ppApp As Object, r As Long, c As Long
Set ppApp = GetObject(, "PowerPoint.Application")
r = 2
Do While Cells(r, 1).Value <> ""
With ppApp
For c = 1 To 2
With .ActiveWindow.View.Slide
.Shapes(c).TextFrame.TextRange.Text = Cells(r, c).Value
End With
Next
With .ActivePresentation
If Cells(r + 1, 1).Value <> "" Then
.Slides(1).Duplicate.MoveTo toPos:=.Slides.Count + 1
End If
End With
.ActiveWindow.View.GotoSlide .ActivePresentation.Slides.Count
End With
r = r + 1
Loop
Set ppApp = Nothing
Application.CutCopyMode = False
End Sub

 

３項目の場合との違いは、７行目を、項目数にあわせて、３⇒２ とするところです。
For c = 1 To 2

 

最後に、まとめの動画を作成していますので、ご参考にしてください。