VBA复制excel数据范围到powerpoint

时间:2016-02-15 09:34:25

标签: excel vba powerpoint

我是VBA /宏的新手,我想将excel中的特定数据范围复制到powerpoint。我在这个网站上搜索了代码,我找到了一些方向很好的东西(见下面的链接),但我不能很好地调整它以使其工作,因为我不了解该语言。

我需要的是一个代码,它在Excel中选择1个列范围(> 150个单元格)并将每个单独的单元格粘贴到幻灯片3及以后的现有powerpoint文件中(单元格A3到幻灯片3,A4到幻灯片4等等) )在右上角。

copy text from Excel cell to PPT textbox

当我尝试举例时,我的版本崩溃了: ThisWorkbook.Sheets( “RMS”)范围( “A3:A8”)。值

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

如果有人能帮助我,我将非常感激,提前谢谢。

2 个答案:

答案 0 :(得分:0)

我在上面提供的符合您需求的链接中写下了对现有代码的一些细微修改。 请注意,您需要使用已保存的幻灯片进行演示,并准备填充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

答案 1 :(得分:0)

正如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