ExcelのデータをPPTにエクスポートしたいです(VBA初心者)

質問

ExcelのデータをPPTにエクスポートしたいです(VBA初心者)
ネット検索などをして、下記の手順でエクスポートすることまではできたのですが、
これだと全てのセルデータがPPTの1つのテキストに入ってしまいます。

希望しているのは、セルごとにエクスポート先の
テキストボックスを分けたいのですが、
ここから先が分かりません。
どなたかご教授いただけませんか。

よろしくお願いします。

<Excel>
A B C D E
１ 会社名(1) 住所(1) 担当者(1)
２ 会社名(2) 住所(2) 担当者(2)
３ 会社名(3) 住所(3) 担当者(3)

<PPT>
・Sheet1
テキストボックス1　　　会社名(1)
テキストボックス2　　　住所(1)
テキストボックス3　　　担当者(1)

・Sheet2
テキストボックス1　　　会社名(2)
テキストボックス2　　　住所(2)
テキストボックス3　　　担当者(2)

---------------------------------------
Sub ExceltoPowerPoint()
Dim objRng As Range
Dim varRng As Variant
Dim intSNum As Integer
Dim i, j As Integer

Dim PpApp As PowerPoint.Application
Dim PpPrs As PowerPoint.Presentation

Set objRng = Worksheets("Sheet1").Range("A1:C5")
varRng = objRng.Value
Set objRng = Nothing

Set PpApp = CreateObject("PowerPoint.Application")
Set PpPrs = PpApp.Presentations.Add

PpApp.Visible = True

intSNum = 1

For i = 1 To UBound(varRng, 1)
PpPrs.Slides.Add i, ppLayoutBlank

PpPrs.Slides(i).Shapes.AddTextbox msoTextOrientationHorizontal, 0, 0, 710, 540
Next

For i = 1 To UBound(varRng, 1)
For j = 1 To UBound(varRng, 2)
With PpPrs.Slides(intSNum).Shapes(1).TextFrame.TextRange
If j = UBound(varRng, 2) Then
.Text = .Text & CStr(varRng(i, j)) & vbNewLine
intSNum = intSNum + 1
Else
.Text = .Text & CStr(varRng(i, j)) & vbNewLine
End If
End With
Next
Next

For i = 1 To UBound(varRng, 1)
With PpPrs.Slides(i).Shapes(1).TextFrame.TextRange
.Font.NameAscii = "Arial"
.Font.NameFarEast = "ＭＳ Ｐゴシック"
.Font.NameOther = "Arial"
.Lines(1).Font.Size = 10 '1行目
.Lines(2).Font.Size = 30 '2行目
.Lines(3).Font.Size = 20 '3行目
End With
Next

MsgBox "処理が終了しました。"

Set PpPrs = Nothing
Set PpApp = Nothing

End Sub
---------------------------------------

回答No.1

mitarashi

前のご質問
http://okwave.jp/qa/q5994307.html
への回答と同様ですが、調査されたコードを生かすと下記の様にできます。
セルデータを一旦配列に入れたり、コードはより難しくなっていると思いますが。
前の質問はお閉め下さい。
Sub ExceltoPowerPoint()
Dim objRng As Range
Dim varRng As Variant
Dim intSNum As Integer
Dim i, j As Integer

Dim PpApp As PowerPoint.Application
Dim PpPrs As PowerPoint.Presentation
Dim PpSlide As PowerPoint.Slide
Dim PpShape As PowerPoint.Shape

Set objRng = Worksheets("Sheet1").Range("A1:C2")
varRng = objRng.Value
Set objRng = Nothing
Set PpApp = CreateObject("PowerPoint.Application")
Set PpPrs = PpApp.Presentations.Add
PpApp.Visible = True
For i = 1 To UBound(varRng, 1)
Set PpSlide = PpPrs.Slides.Add(i, ppLayoutBlank)
For j = 1 To UBound(varRng, 2)
Set PpShape = PpPrs.Slides(i).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 50 + 150 * (j - 1), 710, 140)
With PpShape.TextFrame.TextRange
.Text = CStr(varRng(i, j))
.Font.NameAscii = "Arial"
.Font.NameFarEast = "ＭＳ Ｐゴシック"
.Font.NameOther = "Arial"
.Lines(1).Font.Size = 30 '1行目
End With
Set PpShape = Nothing
Next
Set PpSlide = Nothing
Next
MsgBox "処理が終了しました。"
Set PpPrs = Nothing
Set PpApp = Nothing
End Sub