Excelの範囲をPowerpointノートのセクションに貼り付けます

Question

私はパワーポイントのスライドノートにカラムを貼り付けようとしていますが、1つのセルをつかみ、それを最初のスライドに貼り付けて次のスライドに貼り付けずに次のセルを貼り付けます第2弾のノート。

Sub Notes() 


    Dim PPTApp As PowerPoint.Application 
    Dim PPTPres As PowerPoint.Presentation 
    Dim PPTSlide As PowerPoint.Slide 
    Dim PPTShape As PowerPoint.Shape 
    Dim strNotes As String 
    ' Amended Dim Sh As Shape to... 
    Dim Sh As PowerPoint.Shape 


    'launch powerpoint application 
    Set PPTApp = New PowerPoint.Application 
    PPTApp.Activate 
    'open powerpoint presentation for macmahon off the intranet 
    Set PPTPres = PPTApp.Presentations.Open("C:\Users) 


    Sheets("Raw Data").Select 
    Range("M2:M26").Select 


    Set PPTSlide = PPTPres.Slides(1) 


    On Error GoTo errHandler 




    Do While ActiveCell.Value <> "" 
     ActiveCell.Copy 
     With PPTSlide 
      If PPTSlide.NotesPage.Shapes.Count = 0 Then 'If no shapes to take Notes then add a shape first 
       PPTSlide.NotesPage.Shapes.AddShape msoShapeRectangle, 0, 0, 0, 0 
       Sh = PPTSlide.NotesPage.Shapes(1) 
       'Code change here - did not recognize Sh.TextFrame.TextRange.Text.Paste 
       'So, I set the object text to value of the active cell and seemed to do the trick 


       Sh.TextFrame.TextRange.Text = ActiveCell.Value 
      Else 'has shapes, so see if they take text 
       For Each Sh In PPTSlide.NotesPage.Shapes 
        If Sh.HasTextFrame Then 
         'Code change here - did not recognize Sh.TextFrame.TextRange.Text.Paste 
         'So, I set the object text to value of the active cell and seemed to do the trick 
         Sh.TextFrame.TextRange.Text = ActiveCell.Value 
        End If 
       Next Sh 
      End If 
     End With 
     Set PPTSlide = PPTPres.Slides.Add(PPTPres.Slides.Count + 1, ppLayoutText) 
     ActiveCell.Offset(1, 0).Select 
    Loop 
    Exit Sub 
errHandler: 
    MsgBox Err.Number & vbTab & Err.Description, vbCritical, "Error" 
End Sub 

Answer 1

あなたは、この行に1をスライドさせる一定の基準を設定している：

Set PPTSlide = PPTPres.Slides(1) 

その代わりに、については... Nextループ内のセルの内容をコピーして貼り付けるコードをラップあなたの望むスライドをループします。

For Each PPTSlide In PPTPres.Slides 
    With PPTSlide 
    ' Do the things you need to do on this slide 
    End With 
Next 

またはスライドの事前定義された範囲の管理：あなたの応答のための

Dim lSlideIndex As Long 
For lSlideIndex = 2 to 5 ' Process slides 2 to 5 
    With PPTPres.Slides(lSlideIndex) 
    ' Do the things you need to do on this slide 
    End With 
Next