0
votes

I'm new to VBA/macro's and I want to copy a specific data range in excel to powerpoint. I have searched this website for codes and I found something that goes in the good direction (see link below), but I can't adjust it well enough to make it work since I don't know enough of the language.

What I need is a code that selects 1 column range (>150 cells) in Excel and pastes every individual cell to an existing powerpoint file from slide 3 and onward (cell A3 to slide 3, A4 to slide 4, etc) in the right corner.

copy text from Excel cell to PPT textbox

My version crashes when I try for example: ThisWorkbook.Sheets("RMs").Range("A3:A8").Value

The problem might be that I don't specify the shape well enough and/or give a proper range of slides.

If anyone can help me I would be most grateful, thanks in advance.

2

2 Answers

0
votes

I written down some slight modification of the existing code from the link you gave above that complies with your needs. Be aware that you will need to have the presentation with the slides already saved and ready to be filled with data from Excel. After pasting the cell in each slide based on your logic of cell A3 in slide 3 you can move the newly created shapes with the coordinates of left and top.

Code:

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
0
votes

As Catalin's already mentioned, you must first create the presentation and add enough slides to hold the data you want to paste.

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