VBA将Excel数据范围复制到PowerPoint

Question

我是VBA /宏的新手，我想将excel中的特定数据范围复制到PowerPoint。 我已经在该网站上搜索了代码，但发现有很好的方向（请参见下面的链接），但是由于我对这种语言的了解不够，因此无法对其进行充分调整以使其正常工作。

我需要的是一个代码，该代码在Excel中选择1列范围（> 150个单元格），并将每个单独的单元格从幻灯片3向前粘贴到一个现有的Powerpoint文件中（单元格A3到幻灯片3，A4到幻灯片4，等等）。角。

将文本从Excel单元格复制到PPT文本框

例如，当我尝试时，我的版本崩溃：ThisWorkbook.Sheets（“ RMs”）。Range（“ A3：A8”）。Value

问题可能是我没有很好地指定形状和/或提供了适当范围的幻灯片。

如果有人能帮助我，我将不胜感激，在此先感谢。

Answer 1

我从上面给出的链接中写下了一些符合您需要的现有代码的少量修改。 请注意，您将需要保存幻灯片的演示文稿，并准备用Excel中的数据填充。 根据幻灯片3中单元格A3的逻辑将单元格粘贴到每张幻灯片中之后，您可以使用左坐标和顶部坐标移动新创建的形状。

码：

Option Explicit

Sub Sammple()
    Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
    Dim oPPShape As Object
    Dim FlName As String
    Dim i as integer

    '~~> Change this to the relevant file
    FlName = "C:\MyFile.PPTX"

    '~~> Establish an PowerPoint application object
    On Error Resume Next
    Set oPPApp = GetObject(, "PowerPoint.Application")

    If Err.Number <> 0 Then
        Set oPPApp = CreateObject("PowerPoint.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oPPApp.Visible = True

    '~~> Open the relevant powerpoint file
    Set oPPPrsn = oPPApp.Presentations.Open(FlName)

    for i=3 to ThisWorkbook.Sheets("RMs").Range("A65000").end(xlup).row
    '~~> Change this to the relevant slide which has the shape
    Set oPPSlide = oPPPrsn.Slides(i)        

    '~~> Write to the shape

    ThisWorkbook.Sheets("RMs").Range("A" & i).CopyPicture Appearance:=xlScreen, _
Format:=xlPicture

    oPPSlide.Shapes.Paste.Select
    '
    '~~> Rest of the code
    '
End Sub

Answer 2

正如Catalin所述，您必须首先创建演示文稿并添加足够的幻灯片以保存要粘贴的数据。

Sub AddSlideExamples()

    Dim osl As Slide

    With ActivePresentation
        ' You can duplicate an existing slide that's already set up
        ' the way you want it:
        Set osl = .Slides(1).Duplicate(1)

        ' Or you can add a new slide based on one of the presentation
        ' master layouts:
        Set osl = .Slides.AddSlide(.Slides.Count + 1, .Designs(1).SlideMaster.CustomLayouts(1))

    End With

End Sub