Update multiple powerpoint charts through excel












-1














I have written excel vba script that updates 250 charts in PowerPoint with data from an excel table. The powerpoint has 149 slides and 80 slides have charts. The problem is the script takes ages running and crashes at times. I have tried reducing the chart slides to 20 slides but still no difference. Plus is there a way to save the powerpoint presentation as is instead of saving it as a different file with a different format. Whenever I try to save it as is, I get an error saying the file is read-only. Thanks for the help in advance



Sub updateppt()

Dim myppt As PowerPoint.Presentation
Dim mypptslide As PowerPoint.slide
Dim mypptshape As PowerPoint.shape
Dim mypptchrt As PowerPoint.chart
Dim mypptchrtdta As PowerPoint.ChartData
Dim cTable As Excel.ListObject
Dim mypptApp As PowerPoint.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim shape As Object
Dim slide As Object
Dim FileName As String
Dim lastRow As Range
Dim rng As Range
Dim rng2 As Range

Update_display (False)
Application.Calculation = xlCalculateManual
FileName = ".....test2.pptx"

Set mypptApp = CreateObject("PowerPoint.Application")
Set myppt = mypptApp.Presentations.Open(FileName, WithWindow:=msoFalse)


'set the worksheet where to retrieve the data from
Set wb = ActiveWorkbook
Set ws = wb.Worksheets(3)

'initialize the counter
i = 2

'Loop to go through slides,look for charts then update them
For Each slide In myppt.Slides

For Each shape In slide.Shapes

If shape.HasChart Then
Set chart = shape.chart
Set mypptchrtdta = chart.ChartData
Set cTable = mypptchrtdta.Workbook.Worksheets(1).ListObjects("Table1")


'range of the datato be pasted
Set rng = ws.ListObjects(1).Range.Cells(i, 1)
Set rng2 = ws.ListObjects(1).Range.Cells(i, 2)

'pasting the data
cTable.ListRows.Add AlwaysInsert:=True
cTable.Range.End(xlDown).Offset(1, 0).Value = rng.Value
cTable.Range.End(xlDown).Offset(0, 1).Value = rng2.Value
i = i + 1

End If

Next

Next
Update_display (True)
Application.Calculation = xlCalculateAutomatic

myppt.SaveAs FileName, ppSaveAsOpenXMLPresentation

i = i - 1
MsgBox Prompt:=i & " Charts have been updated", Buttons:=vbInformation

mypptApp.Quit
End Sub

'sub to deal with popups
Sub Update_display(bSwitch As Boolean)

Application.ScreenUpdating = bSwitch
Application.EnableEvents = bSwitch
Application.DisplayAlerts = bSwitch
Application.DisplayPasteOptions = bSwitch
Application.ScreenUpdating = bSwitch
Application.DisplayStatusBar = bSwitch

End Sub








share







New contributor




bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.

























    -1














    I have written excel vba script that updates 250 charts in PowerPoint with data from an excel table. The powerpoint has 149 slides and 80 slides have charts. The problem is the script takes ages running and crashes at times. I have tried reducing the chart slides to 20 slides but still no difference. Plus is there a way to save the powerpoint presentation as is instead of saving it as a different file with a different format. Whenever I try to save it as is, I get an error saying the file is read-only. Thanks for the help in advance



    Sub updateppt()

    Dim myppt As PowerPoint.Presentation
    Dim mypptslide As PowerPoint.slide
    Dim mypptshape As PowerPoint.shape
    Dim mypptchrt As PowerPoint.chart
    Dim mypptchrtdta As PowerPoint.ChartData
    Dim cTable As Excel.ListObject
    Dim mypptApp As PowerPoint.Application
    Dim wb As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim shape As Object
    Dim slide As Object
    Dim FileName As String
    Dim lastRow As Range
    Dim rng As Range
    Dim rng2 As Range

    Update_display (False)
    Application.Calculation = xlCalculateManual
    FileName = ".....test2.pptx"

    Set mypptApp = CreateObject("PowerPoint.Application")
    Set myppt = mypptApp.Presentations.Open(FileName, WithWindow:=msoFalse)


    'set the worksheet where to retrieve the data from
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(3)

    'initialize the counter
    i = 2

    'Loop to go through slides,look for charts then update them
    For Each slide In myppt.Slides

    For Each shape In slide.Shapes

    If shape.HasChart Then
    Set chart = shape.chart
    Set mypptchrtdta = chart.ChartData
    Set cTable = mypptchrtdta.Workbook.Worksheets(1).ListObjects("Table1")


    'range of the datato be pasted
    Set rng = ws.ListObjects(1).Range.Cells(i, 1)
    Set rng2 = ws.ListObjects(1).Range.Cells(i, 2)

    'pasting the data
    cTable.ListRows.Add AlwaysInsert:=True
    cTable.Range.End(xlDown).Offset(1, 0).Value = rng.Value
    cTable.Range.End(xlDown).Offset(0, 1).Value = rng2.Value
    i = i + 1

    End If

    Next

    Next
    Update_display (True)
    Application.Calculation = xlCalculateAutomatic

    myppt.SaveAs FileName, ppSaveAsOpenXMLPresentation

    i = i - 1
    MsgBox Prompt:=i & " Charts have been updated", Buttons:=vbInformation

    mypptApp.Quit
    End Sub

    'sub to deal with popups
    Sub Update_display(bSwitch As Boolean)

    Application.ScreenUpdating = bSwitch
    Application.EnableEvents = bSwitch
    Application.DisplayAlerts = bSwitch
    Application.DisplayPasteOptions = bSwitch
    Application.ScreenUpdating = bSwitch
    Application.DisplayStatusBar = bSwitch

    End Sub








    share







    New contributor




    bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
    Check out our Code of Conduct.























      -1












      -1








      -1







      I have written excel vba script that updates 250 charts in PowerPoint with data from an excel table. The powerpoint has 149 slides and 80 slides have charts. The problem is the script takes ages running and crashes at times. I have tried reducing the chart slides to 20 slides but still no difference. Plus is there a way to save the powerpoint presentation as is instead of saving it as a different file with a different format. Whenever I try to save it as is, I get an error saying the file is read-only. Thanks for the help in advance



      Sub updateppt()

      Dim myppt As PowerPoint.Presentation
      Dim mypptslide As PowerPoint.slide
      Dim mypptshape As PowerPoint.shape
      Dim mypptchrt As PowerPoint.chart
      Dim mypptchrtdta As PowerPoint.ChartData
      Dim cTable As Excel.ListObject
      Dim mypptApp As PowerPoint.Application
      Dim wb As Excel.Workbook
      Dim ws As Excel.Worksheet
      Dim shape As Object
      Dim slide As Object
      Dim FileName As String
      Dim lastRow As Range
      Dim rng As Range
      Dim rng2 As Range

      Update_display (False)
      Application.Calculation = xlCalculateManual
      FileName = ".....test2.pptx"

      Set mypptApp = CreateObject("PowerPoint.Application")
      Set myppt = mypptApp.Presentations.Open(FileName, WithWindow:=msoFalse)


      'set the worksheet where to retrieve the data from
      Set wb = ActiveWorkbook
      Set ws = wb.Worksheets(3)

      'initialize the counter
      i = 2

      'Loop to go through slides,look for charts then update them
      For Each slide In myppt.Slides

      For Each shape In slide.Shapes

      If shape.HasChart Then
      Set chart = shape.chart
      Set mypptchrtdta = chart.ChartData
      Set cTable = mypptchrtdta.Workbook.Worksheets(1).ListObjects("Table1")


      'range of the datato be pasted
      Set rng = ws.ListObjects(1).Range.Cells(i, 1)
      Set rng2 = ws.ListObjects(1).Range.Cells(i, 2)

      'pasting the data
      cTable.ListRows.Add AlwaysInsert:=True
      cTable.Range.End(xlDown).Offset(1, 0).Value = rng.Value
      cTable.Range.End(xlDown).Offset(0, 1).Value = rng2.Value
      i = i + 1

      End If

      Next

      Next
      Update_display (True)
      Application.Calculation = xlCalculateAutomatic

      myppt.SaveAs FileName, ppSaveAsOpenXMLPresentation

      i = i - 1
      MsgBox Prompt:=i & " Charts have been updated", Buttons:=vbInformation

      mypptApp.Quit
      End Sub

      'sub to deal with popups
      Sub Update_display(bSwitch As Boolean)

      Application.ScreenUpdating = bSwitch
      Application.EnableEvents = bSwitch
      Application.DisplayAlerts = bSwitch
      Application.DisplayPasteOptions = bSwitch
      Application.ScreenUpdating = bSwitch
      Application.DisplayStatusBar = bSwitch

      End Sub








      share







      New contributor




      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.











      I have written excel vba script that updates 250 charts in PowerPoint with data from an excel table. The powerpoint has 149 slides and 80 slides have charts. The problem is the script takes ages running and crashes at times. I have tried reducing the chart slides to 20 slides but still no difference. Plus is there a way to save the powerpoint presentation as is instead of saving it as a different file with a different format. Whenever I try to save it as is, I get an error saying the file is read-only. Thanks for the help in advance



      Sub updateppt()

      Dim myppt As PowerPoint.Presentation
      Dim mypptslide As PowerPoint.slide
      Dim mypptshape As PowerPoint.shape
      Dim mypptchrt As PowerPoint.chart
      Dim mypptchrtdta As PowerPoint.ChartData
      Dim cTable As Excel.ListObject
      Dim mypptApp As PowerPoint.Application
      Dim wb As Excel.Workbook
      Dim ws As Excel.Worksheet
      Dim shape As Object
      Dim slide As Object
      Dim FileName As String
      Dim lastRow As Range
      Dim rng As Range
      Dim rng2 As Range

      Update_display (False)
      Application.Calculation = xlCalculateManual
      FileName = ".....test2.pptx"

      Set mypptApp = CreateObject("PowerPoint.Application")
      Set myppt = mypptApp.Presentations.Open(FileName, WithWindow:=msoFalse)


      'set the worksheet where to retrieve the data from
      Set wb = ActiveWorkbook
      Set ws = wb.Worksheets(3)

      'initialize the counter
      i = 2

      'Loop to go through slides,look for charts then update them
      For Each slide In myppt.Slides

      For Each shape In slide.Shapes

      If shape.HasChart Then
      Set chart = shape.chart
      Set mypptchrtdta = chart.ChartData
      Set cTable = mypptchrtdta.Workbook.Worksheets(1).ListObjects("Table1")


      'range of the datato be pasted
      Set rng = ws.ListObjects(1).Range.Cells(i, 1)
      Set rng2 = ws.ListObjects(1).Range.Cells(i, 2)

      'pasting the data
      cTable.ListRows.Add AlwaysInsert:=True
      cTable.Range.End(xlDown).Offset(1, 0).Value = rng.Value
      cTable.Range.End(xlDown).Offset(0, 1).Value = rng2.Value
      i = i + 1

      End If

      Next

      Next
      Update_display (True)
      Application.Calculation = xlCalculateAutomatic

      myppt.SaveAs FileName, ppSaveAsOpenXMLPresentation

      i = i - 1
      MsgBox Prompt:=i & " Charts have been updated", Buttons:=vbInformation

      mypptApp.Quit
      End Sub

      'sub to deal with popups
      Sub Update_display(bSwitch As Boolean)

      Application.ScreenUpdating = bSwitch
      Application.EnableEvents = bSwitch
      Application.DisplayAlerts = bSwitch
      Application.DisplayPasteOptions = bSwitch
      Application.ScreenUpdating = bSwitch
      Application.DisplayStatusBar = bSwitch

      End Sub






      vba





      share







      New contributor




      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.










      share







      New contributor




      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.








      share



      share






      New contributor




      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.









      asked 9 mins ago









      bryanstefans

      1




      1




      New contributor




      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.





      New contributor





      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.






      bryanstefans is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
      Check out our Code of Conduct.



























          active

          oldest

          votes











          Your Answer





          StackExchange.ifUsing("editor", function () {
          return StackExchange.using("mathjaxEditing", function () {
          StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
          StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
          });
          });
          }, "mathjax-editing");

          StackExchange.ifUsing("editor", function () {
          StackExchange.using("externalEditor", function () {
          StackExchange.using("snippets", function () {
          StackExchange.snippets.init();
          });
          });
          }, "code-snippets");

          StackExchange.ready(function() {
          var channelOptions = {
          tags: "".split(" "),
          id: "196"
          };
          initTagRenderer("".split(" "), "".split(" "), channelOptions);

          StackExchange.using("externalEditor", function() {
          // Have to fire editor after snippets, if snippets enabled
          if (StackExchange.settings.snippets.snippetsEnabled) {
          StackExchange.using("snippets", function() {
          createEditor();
          });
          }
          else {
          createEditor();
          }
          });

          function createEditor() {
          StackExchange.prepareEditor({
          heartbeatType: 'answer',
          autoActivateHeartbeat: false,
          convertImagesToLinks: false,
          noModals: true,
          showLowRepImageUploadWarning: true,
          reputationToPostImages: null,
          bindNavPrevention: true,
          postfix: "",
          imageUploader: {
          brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
          contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
          allowUrls: true
          },
          onDemand: true,
          discardSelector: ".discard-answer"
          ,immediatelyShowMarkdownHelp:true
          });


          }
          });






          bryanstefans is a new contributor. Be nice, and check out our Code of Conduct.










          draft saved

          draft discarded


















          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f210692%2fupdate-multiple-powerpoint-charts-through-excel%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown






























          active

          oldest

          votes













          active

          oldest

          votes









          active

          oldest

          votes






          active

          oldest

          votes








          bryanstefans is a new contributor. Be nice, and check out our Code of Conduct.










          draft saved

          draft discarded


















          bryanstefans is a new contributor. Be nice, and check out our Code of Conduct.













          bryanstefans is a new contributor. Be nice, and check out our Code of Conduct.












          bryanstefans is a new contributor. Be nice, and check out our Code of Conduct.
















          Thanks for contributing an answer to Code Review Stack Exchange!


          • Please be sure to answer the question. Provide details and share your research!

          But avoid



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          Use MathJax to format equations. MathJax reference.


          To learn more, see our tips on writing great answers.





          Some of your past answers have not been well-received, and you're in danger of being blocked from answering.


          Please pay close attention to the following guidance:


          • Please be sure to answer the question. Provide details and share your research!

          But avoid



          • Asking for help, clarification, or responding to other answers.

          • Making statements based on opinion; back them up with references or personal experience.


          To learn more, see our tips on writing great answers.




          draft saved


          draft discarded














          StackExchange.ready(
          function () {
          StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f210692%2fupdate-multiple-powerpoint-charts-through-excel%23new-answer', 'question_page');
          }
          );

          Post as a guest















          Required, but never shown





















































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown

































          Required, but never shown














          Required, but never shown












          Required, but never shown







          Required, but never shown







          Popular posts from this blog

          Morgemoulin

          Scott Moir

          Souastre