Results 1 to 7 of 7

Thread: Excel workbook to powerpoint with animation
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Jul 2018
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Excel workbook to powerpoint with animation

    I'm not so good in VBA so I hope someone with more knowledge can help me. I have a *.xls file with nine Worksheet, in each worksheet there are two charts.
    What I want to do is to move the two charts from worksheet one to first page of a powerpoint file, place the two charts next to each other. Make a animation so these two appear togeather.
    Then place the two charts from worksheet two as next animation on top of the first one in the powerpoint file and so on for all nine worksheets.
    The result will be one page powerpoint with nine animations points, showing 18 different charts.

    I have so far below code (not mine) which move the charts, but create a new page for each chart, but I would want it to make a animation of each chart instead.

    Hope someone can tell me how I can change the code or maybe a link to where it is explained.

    Thank you

    Code:
       
        Option Explicit
    
    Private Sub CommandButton1_Click()
        exportCharts2Ppt
    End Sub
    
    Sub exportCharts2Ppt()
        'Dim filename As String
        ' Create a PowerPoint application object.
        Dim objPPT As PowerPoint.Application
        Set objPPT = New PowerPoint.Application
        objPPT.Visible = True           ' Make the PPT visible.
        objPPT.Activate
        
        ' Create a PowerPoint presentation object.
        Dim objPptPre As PowerPoint.Presentation
        Set objPptPre = objPPT.Presentations.Add
        
        ' We'll show different charts in different slides in our PowerPoint presentation.
        ' Therefore, create an object for PPT slides.
        Dim objPPTSlides As PowerPoint.Slide
        
        Dim iNdx As Integer     ' Index, or position of each slide.
        iNdx = 1
        
        Dim objChart As ChartObject
        Dim objWS As Worksheet
        
        For Each objWS In ActiveWorkbook.Worksheets     ' Loop through all the worksheets.
            For Each objChart In objWS.ChartObjects     ' Loop through all the Chart Objects.
            
              
                objChart.Chart.ChartArea.Copy       ' Copy all the charts to the Clipboard.
                ' Debug.Print objChart.Chart.Name
                'ActiveChart.ChartTitle.Text = filename
                Set objPPTSlides = objPptPre.Slides.Add(iNdx, ppLayoutBlank)       ' Create a new slide with a blank layout.
                objPPTSlides.Shapes.PasteSpecial ppPasteDefault, msoTrue           ' Extract the chart from the Clipboad and paste it.
                
                iNdx = iNdx + 1         ' Increment the slide index (or position).
            Next objChart
        Next objWS
        
    End Sub

  2. #2
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,727
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    The code creates this animation:




    Code:
    ' Excel module
    Sub exportCharts2Ppt()
    Dim objPPT As powerpoint.Application, sld As Slide, n%, i%, sh As powerpoint.Shape
    Dim pres As Presentation, cht As ChartObject, ws As Worksheet
    Set objPPT = New powerpoint.Application
    objPPT.Visible = True
    objPPT.Activate
    Set pres = objPPT.Presentations.Add
    Set sld = pres.Slides.Add(1, ppLayoutBlank)
    Set ws = ActiveWorkbook.Worksheets(1)
    n = 1
    For Each ws In ActiveWorkbook.Worksheets
        For i = 1 To 2
            Set cht = ws.ChartObjects(i)
            cht.Chart.ChartArea.Copy
            sld.Shapes.PasteSpecial ppPasteDefault, msoTrue
        Next
        Set sh = sld.Shapes(n)
        sh.Name = "Chart" & n
        sh.Width = pres.PageSetup.SlideWidth / 2
        sh.Height = pres.PageSetup.SlideHeight / 2
        sh.Top = 10
        sh.Left = 10
        Set sh = sld.Shapes(n + 1)
        sh.Name = "Chart" & n + 1
        sh.Width = pres.PageSetup.SlideWidth / 2
        sh.Height = pres.PageSetup.SlideHeight / 2
        sh.Top = 10
        sh.Left = pres.PageSetup.SlideWidth / 2
        AddEff sld, n, 22, 1, False
        AddEff sld, n + 1, 22, 2, False
        If n > 1 Then
            AddEff sld, n - 2, 22, 2, True
            AddEff sld, n - 1, 22, 2, True
        End If
        n = n + 2
    Next
    MsgBox sld.Shapes.Count & " charts processed.", , "done"
    End Sub
    Sub AddEff(sl As Slide, shn, eid, trig, ext As Boolean)
    Dim eff As Effect
    Set eff = sl.TimeLine.MainSequence.AddEffect(sl.Shapes(shn), eid, , trig)
    eff.EffectParameters.Direction = 4
    eff.Timing.Duration = 2
    If ext Then eff.Exit = msoTrue
    End Sub
    '**********
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  3. #3
    New Member
    Join Date
    Jul 2018
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    Hi Worf,

    Thank you for your great solution, this is exactly what I want the program to perform.

    A further question on the same topic: Is it possible to change the code so it read several *.xls files from a folder and perform your program on different page on same *.ppt.
    So what I want it to do is to let say I have folder with three *.xls-files (can be many more) open the first *.xls-file perform your solution and move charts from the *.xls-file to first page of the *.ppt-file. Close the *.xls-file open the second *.xls-file in the same folder move the charts with your program to the second page of the *.ppt-file close the *.xls file. Open the third *.xls file and so on until all *.xls-files charts in the folder is moved to the *.ppt with animation.

    Thank you for your solution

  4. #4
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,727
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    New version:

    Code:
    Dim objppt As PowerPoint.Application, pres As Presentation, s$
    
    
    Sub OpenFiles() ' run me
    Dim wb As Workbook, MyFile$, Directory$
    Set objppt = New PowerPoint.Application
    objppt.Visible = True
    objppt.Activate
    Set pres = objppt.Presentations.Add
    Directory = "c:\pub\2017\"
    MyFile = Dir(Directory & "*.xls")
    s = ""
    Do While MyFile <> ""
        Set wb = Workbooks.Open(Filename:=Directory & MyFile)
        exportCharts wb
        MyFile = Dir()
        wb.Close 0
    Loop
    MsgBox s, , "Finished."
    End Sub
    
    
    Sub exportCharts(wb As Workbook)
    Dim sld As Slide, n%, i%, sh As PowerPoint.shape, cht As ChartObject, ws As Worksheet
    Set sld = pres.Slides.Add(1, ppLayoutBlank)
    n = 1
    For Each ws In wb.Worksheets
        For i = 1 To 2
            Set cht = ws.ChartObjects(i)
            cht.Chart.ChartArea.Copy
            sld.Shapes.PasteSpecial ppPasteDefault, msoTrue
        Next
        Set sh = sld.Shapes(n)
        sh.Name = "Chart" & n
        sh.Width = pres.PageSetup.SlideWidth / 2
        sh.Height = pres.PageSetup.SlideHeight / 2
        sh.Top = 10:    sh.Left = 10
        Set sh = sld.Shapes(n + 1)
        sh.Name = "Chart" & n + 1
        sh.Width = pres.PageSetup.SlideWidth / 2
        sh.Height = pres.PageSetup.SlideHeight / 2
        sh.Top = 10
        sh.Left = pres.PageSetup.SlideWidth / 2
        AddEff sld, n, 22, 1, False
        AddEff sld, n + 1, 22, 2, False
        If n > 1 Then
            AddEff sld, n - 2, 22, 2, True
            AddEff sld, n - 1, 22, 2, True
        End If
        n = n + 2
    Next
    s = s & sld.Shapes.Count & " charts processed for " & wb.Name & vbLf
    End Sub
    
    
    Sub AddEff(sl As Slide, shn, eid, trig, ext As Boolean)
    Dim eff As Effect
    Set eff = sl.TimeLine.MainSequence.AddEffect(sl.Shapes(shn), eid, , trig)
    eff.EffectParameters.Direction = 4
    eff.Timing.Duration = 2
    If ext Then eff.Exit = msoTrue
    End Sub
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  5. #5
    New Member
    Join Date
    Jul 2018
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    Thank you Worf for the great code. This is exactly what what to achieve.

    Is there a easy way to make the Y-scale on the *.xls-file charts to the same size while moving over to the *.ppt. Let say that the first charts' Y-ax have max value of 3 and the second charts' max Y-ax is set to 30. So all charts on the *.ppt file have the same Y-size/scale.

    Or should this be done before the transfer code is used, and if so is there a recommendation on how to do it?

    Thank you for you answers

  6. #6
    Board Regular Worf's Avatar
    Join Date
    Oct 2011
    Location
    Rio, Brazil
    Posts
    3,727
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    You can insert this line in the existing code:

    Code:
    Sub mscale()
    Dim ws As Worksheet, i%, cht As ChartObject
    For Each ws In ActiveWorkbook.Worksheets
        For i = 1 To 2
            Set cht = ws.ChartObjects(i)
            cht.Chart.Axes(xlValue).MaximumScale = 30
        Next
    Next
    End Sub
    Excel 2013 / Windows 8.1 (home)
    Excel 2013 / windows 7 (work)


  7. #7
    New Member
    Join Date
    Jul 2018
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Excel workbook to powerpoint with animation

    Thank you Worf, for all the great code and suggestions. This does now exactly what I want to achieve, makes it so much easier to compare the charts.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •