Update multiple powerpoint charts through excel
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
New contributor
add a comment |
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
New contributor
add a comment |
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
New contributor
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
vba
New contributor
New contributor
New contributor
asked 9 mins ago
bryanstefans
1
1
New contributor
New contributor
add a comment |
add a comment |
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.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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.
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.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
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
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
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