Question

所以我试图将一个列粘贴到powerpoint幻灯片中，但它只抓取一个单元格并将其粘贴到第一张幻灯片中，不会转到下一张幻灯片并将下一个单元格粘贴到第二张幻灯片的注释中。 / p>

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)

而不是那样，包装代码以将单元格内容复制并粘贴到For ... 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

将Excel范围粘贴到Powerpoint Notes部分

1 个答案: