excelからpptへデータを連続して貼り付けたい

表題の通り、EXCELの１列目に自作の問題、２列目にその答えがあります。（６００行くらい）
それを順番にパワーポイントに連続して貼り付けたいのですが
http://www.relief.jp/itnote/archives/excel-vba-m …
こちらのサイトを参考にしたいのですが、パワーポイント側は
１行目に、問題
２行目に、その答え
というふうに貼り付けて、表示させるにはどうしたらいいでしょうか？
１つのページに問題とその答え
２メージ目にまた問題とその答えという感じです。
上のサイトの例では、行ではなく列に問題と答えが順番に表示されています。
是非やり方を教えてください。

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2015/06/24 20:19

こんにちは。

返事をつけるのが遅くなってしまいました。
リンク先の「インストラクターのネタ帳」のサイトが、本日、ずっと開かなかったので、しばらく確認できませんでした。

こんな感じでしょうか？
ただ、
>表題の通り、EXCELの１列目に自作の問題、２列目にその答えがあります。（６００行くらい）

って、パワーポイントにそんなにページを作るのでしょうか？
大丈夫か分かりません。


'//
Sub PPTgetXlData()
　Dim objPPT As Object
　Dim objPrsn As Object
　Dim shp As Object
　Dim i As Long
　Dim p As Long
　With ActiveSheet
　　p = .Cells(Rows.Count, 1).End(xlUp).Row
　　If p > 700 Then
　　　If MsgBox("Too Many Data", vbExclamation + vbOKCancel) = vbCancel Then
　　　　Exit Sub
　　　End If
　　End If
　End With
　On Error Resume Next
　'パワーポイント起動
　Set objPPT = GetObject(, "PowerPoint.Application")
　On Error GoTo 0
　If objPPT Is Nothing Then
　　Set objPPT = CreateObject("PowerPoint.Application")
　End If
　If objPPT Is Nothing Then MsgBox "NOT Exist PPT": Exit Sub
　With objPPT
　　.Visible = True
　　Set objPrsn = .Presentations.Add
　End With
　For i = 1 To p
　　With objPrsn.Slides
　　　.Add Index:=i, Layout:=4
　　　With .Item(i)
　　　　Set shp = .Shapes.AddTable(NumRows:=2, NumColumns:=1, _
　　　　Left:=130, Top:=100, Width:=500, Height:=300)
　　　End With
　　　'With shp ～　End with ここにテーブルの書式設定を入れる
　　　With shp.Table
　　　　.Cell(1, 1).Shape.TextFrame.TextRange = Cells(i, 1).Value
　　　　.Cell(2, 1).Shape.TextFrame.TextRange = Cells(i, 2).Value
　　　End With
　　End With
　Next i
　Set objPrsn = Nothing
　Set objPPT = Nothing
End Sub
'///

この回答へのお礼

すごいです！！　完璧です。
どうもありがとうございます。
書いて頂いた１つ１つの命令を追いながら自分なりに勉強してみます。
PPTのページ数が多いので無理なようです。行を少なくして
わけてやってみますね　
ありがとうございました。

お礼日時：2015/06/25 14:18