none
Transfer data to powerpoint with vba RRS feed

  • Question

  • Good evening all

    I apologies, as this question has been asked a few times (I believe), but I cannot seem  to get them to work with my specific requirement.

    As the title suggests I am trying to get data from Excel into a Powerpoint Presentation, however; I am also trying to have the code work the opposite way round too Powerpoint to Excel.

    I have a project database which contains all of my current projects "Projects.xlsx". Every day I have to deliver an update presentation and everyday I have to copy and paste all of the data required across to the presentation "Projects.pptx". During the presentation I receive information which I annotate onto the presentation and then have to copy it across to the Excel later. Therefore I would like to have the code so updates work both ways.

    The data presented is pretty simple, as it is only 4 columns of data, however; every row is required to be presented on a separate slide, and there is also a possibility that a chart could be required. Projects are added on a daily basis. However, Row 1 would be Slide 1, Row 2 would be Slide 2 etc..

    for arguments sake the data is on "Sheet1" in columns A to D.

    Both the Presentation and Workbook are located at C:\Users\steven\Desktop\Projects

    Each Slide will look similar to this.

    I hope you can help

    Thank you in advance

    Wednesday, June 14, 2017 7:12 PM

Answers

  • Hi Steve MW,

    I can see that you had not responded to this thread for a long time.

    is your issue is solved now?

    if yes then try to post the solution and mark it as an answer.

    if your issue is exist then try to refer the solution given by me.

    I can see that suggestion given by me can able to solve your issue.

    so I suggest you to check it and if you think that it can solve your issue then try to mark that suggestion as an answer.

    so that we can close this thread.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Steve MW Tuesday, July 18, 2017 6:26 AM
    Thursday, June 29, 2017 8:11 AM
    Moderator

All replies

  • Hi Steve MW,

    to transfer the data from Excel to Powerpoint , you can use code below.

    Sub Demo()
    
    
    Dim rng As Range
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim myShape As Object
    
    'Copy Range from Excel
      Set rng = ThisWorkbook.ActiveSheet.Range("A1:C12")
    
    'Create an Instance of PowerPoint
      On Error Resume Next
        
        'Is PowerPoint already opened?
          Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        
        'Clear the error between errors
          Err.Clear
    
        'If PowerPoint is not already open then open PowerPoint
          If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
        
        'Handle if the PowerPoint Application is not found
          If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
          End If
    
      On Error GoTo 0
    
    'Optimize Code
      Application.ScreenUpdating = False
      
    'Create a New Presentation
      Set myPresentation = PowerPointApp.Presentations.Add
    
    'Add a slide to the Presentation
      Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
    
    'Copy Excel Range
      rng.Copy
    
    'Paste to PowerPoint and position
      mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
      Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
      
        'Set .Left = 66
          myShape.Top = 152
    
    'Make PowerPoint Visible and Active
      PowerPointApp.Visible = True
      PowerPointApp.Activate
    
    'Clear The Clipboard
      Application.CutCopyMode = False
      
    End Sub

    if you want another example then you can refer link below.

    Copy Data from Excel to Powerpoint in VBA....

    to copy the data from Powerpoint to Excel you can try to refer code below.

    Sub Demo2()
    
        Dim oSl As Slide
        Dim oTbl As Table
        Dim lCol As Long
        Dim lRow As Long
    
            Dim xlApp As Object
            Dim xlWorkBook As Object
            
            Set xlApp = CreateObject("Excel.Application")
            
            xlApp.Visible = True
            Set xlWorkBook = xlApp.Workbooks.Open("C:\Users\v-padee\Desktop\fle1.xlsx", True, False)
    
    
        For Each oSl In ActivePresentation.Slides
            Set oTbl = GetFirstTable(oSl)
            If oTbl Is Nothing Then
                Exit For
            End If
    
            With oTbl
                For lCol = 1 To .Columns.Count
                    For lRow = 1 To .Rows.Count
                    xlWorkBook.sheets(1).Range("A" & lRow).Value = oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange.Text
                        Debug.Print oTbl.Cell(lRow, lCol).Shape.TextFrame.TextRange.Text
                    Next
                Next
            End With
        Next
        xlWorkBook.Save
        xlWorkBook.Close
    Set xlApp = Nothing
    Set xlWorkBook = Nothing
    End Sub
    
    Function GetFirstTable(oSl As Slide) As Table
        Dim oSh As Shape
        For Each oSh In oSl.Shapes
            If oSh.HasTable Then
                Set GetFirstTable = oSh.Table
                Exit Function
            End If
        Next
    End Function
    
    

    you need to modify the code as per your requirement, above code is just for the example.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Thursday, June 15, 2017 5:57 AM
    Moderator
  • Deepak

    Many thanks for your time. Your first example is something similar to what I have already tried.

    The problem I have is that currently I have 28 rows of data, and would like each row to be on a separate slide. i.e. Row2, Slide2, Row3, Slide3 etc. with the slide in the rough format as above. At present using your example all 28 Rows and 4 columns are pasted onto a single slide.

    Regards


    Steve

    Thursday, June 15, 2017 12:02 PM
  • Hi Steve MW,

    you had mentioned that,"The problem I have is that currently I have 28 rows of data, and would like each row to be on a separate slide. i.e. Row2, Slide2, Row3, Slide3 etc. "

    please refer code below.

    Sub demo()
    
    Dim OWB As New Excel.Workbook
    Set OWB = Excel.Application.Workbooks.Open("C:\Users\v-padee\Desktop\pptdata.xlsx")
    Dim WS As Excel.Worksheet
    Set WS = OWB.Worksheets(1)
    Dim str As String
    Dim i, j As Long
    
    
    For i = 1 To WS.Range("A65536").End(xlUp).Row
        
        ActivePresentation.Slides(1).Copy
        ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
    
       
        Dim LastCol As Long
        LastCol = WS.Rows(i).End(xlToRight).Column
        If LastCol = 16384 Then LastCol = 1
    
        str = ""
        For j = 1 To LastCol
            If j <> 1 Then str = str & Chr(13)
            str = str & WS.Cells(i, j).Value
        Next
    
      
        ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes(1).TextFrame.TextRange.Text = str
    
    Next
    End Sub

    you can see in Excel I have 15 rows.

    it will start pasting data from second slide. so you can see that it had created 16 slides.

    you can try to modify the code as per your requirement.

    to reverse the same process and again export data from each ppt slide to Excel file you can refer code below.

    Sub demo2()
    
        On Error Resume Next
        
       
        Dim OWB As Excel.Workbook
        Set OWB = Workbooks.Add
        Dim CurXLRow As Integer
        Dim CurXLCol As Integer
        CurXLRow = 1
        Dim strFileName As String
        Dim i, j As Long
    
        For i = 1 To ActivePresentation.Slides.Count
            CurXLCol = 1
            For j = 1 To ActivePresentation.Slides(i).Shapes.Count
                If ActivePresentation.Slides(i).Shapes(j).HasTextFrame = msoTrue Then
                    OWB.Worksheets(1).Cells(CurXLRow, CurXLCol).Value = ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Text
                    CurXLCol = CurXLCol + 1
                End If
            Next
            CurXLRow = CurXLRow + 1
        Next
            
     
        strFileName = InputBox("Enter the full path to save the file as (e.g C:\Users\v-padee\Desktop\pptdata1.xlsx:", "Creating New File...")
        If strFileName <> "" Then
            OWB.SaveAs strFileName
        Else
            MsgBox ("Invalid filename. Excel Export not saved")
        End If
        If Err.Number <> 0 Then
            MsgBox ("There was an error saving the file.")
        End If
        
        
        OWB.Close
    End Sub
    
    

    Output:

    here you just need to set the format of data as per your requirement.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, June 19, 2017 8:29 AM
    Moderator
  • Hi Steve MW,

    I can see that you had not responded to this thread for a long time.

    is your issue is solved now?

    if yes then try to post the solution and mark it as an answer.

    if your issue is exist then try to refer the solution given by me.

    I can see that suggestion given by me can able to solve your issue.

    so I suggest you to check it and if you think that it can solve your issue then try to mark that suggestion as an answer.

    so that we can close this thread.

    Regards

    Deepak


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    • Marked as answer by Steve MW Tuesday, July 18, 2017 6:26 AM
    Thursday, June 29, 2017 8:11 AM
    Moderator
  • Deepak

    I do apologies, i am in the Royal Navy and deployed for a while. I am back home now and have tried your solution and yes it works, i will mark it as Answered.

    Many thanks

    Steve

    Tuesday, July 18, 2017 6:26 AM