Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam
Hi there,
I'm struggling to get the save portion of the code below to work. Basically, the intention is to open a powerpoint file embedded in excel; copy, paste and format some ranges from excel as bulleted lists in some slides (All of this works fine), and then save the powerpoint to the user's desktop and close the file.
The error occurs at the Save PRESENTATION section at the very bottom, and I get a dialogue box in powerpoint that says "An error occurred while saving the powerpoint file", with and OK button. On clicking OK, and then viewing the code in the VBA editor, the attached error shows.
Using SaveAs, instead of SaveCopyAs makes no difference. I have read that this error can occur when the Powerpoint is opened as read only, but I am quite sure that it is not the case when the code is running.
If I comment out the save code everything else works fine.
Any help or suggestions would be greatly appreciated!
Set myWorkbook = ActiveWorkbook
'| Activate worksheet with embedded PowerPoint template and selct cell A1 | _
(Selection of A1 to ensure that the PowerPoint object is not active otherwise selection Verb below will not work.)
myWorkbook.Worksheets("Embed").Visible = True
myWorkbook.Worksheets("Embed").Select
ActiveSheet.Range("A1").Select
ActiveCell.Value = "OK"
'| Open the embedded PowerPoint template, and set variable |
ActiveSheet.Shapes.Range(Array("OutputTemplate")).Select
Selection.Verb Verb:=3
Set ppApp = GetObject(, "Powerpoint.Application")
Set myPresentation = ppApp.ActivePresentation
'********************************
'CLEAR SLIDES
'| In the open template, clear each slide |
For Each Slide In myPresentation.Slides
For Each Shape In Slide.Shapes
Shape.TextFrame.TextRange.Text = ""
Next Shape
Next Slide
'********************************
'SET SLIDE INFORMATION
'| Title Slide (Slide 1) |
'Set variables
With myPresentation.Slides(1)
Set TitleShape = .Shapes.Title
Set SubTitleShape = .Shapes(1)
End With
'Update Variables with information from Excel
TitleShape.TextFrame.TextRange.Text = Range("Customer").Text
SubTitleShape.TextFrame.TextRange.Text = Range("PowerPointTitle").Text
'| Slide Hard Benefits |
'Set variables
With myPresentation.Slides(Range("Hard_Direct_Benefits").Value)
Set TitleShape = .Shapes.Title
Set slideText = .Shapes(1)
'Title of Slide
TitleShape.TextFrame.TextRange.Text = Range("Hard_Direct_Benefits_Title").Text
'Set Text Frame as bulleted
With slideText.TextFrame.TextRange.ParagraphFormat.Bullet
.Visible = True
.Character = 8226
End With
'Text Lead In
slideText.TextFrame.TextRange.Text = Range("Hard_Direct_Benefits_Lead_In").Text & vbNewLine
'Loop through Bulleted List
For Each Cell In Range("Hard_Direct_Benefits_Bullets")
slideText.TextFrame.TextRange.InsertAfter Cell.Value & vbNewLine
'Adjust indents
With slideText.TextFrame.TextRange
.Lines(Start:=1, Length:=1).ParagraphFormat.Bullet = msoFalse
.Lines(Start:=3, Length:=1).IndentLevel = 2
End With
End With
'| Slide Hard Indirect Benefits |
'Set variables
With myPresentation.Slides(Range("Hard_Indirect_Benefits").Value)
Set TitleShape = .Shapes.Title
Set slideText = .Shapes(1)
'Title of Slide
TitleShape.TextFrame.TextRange.Text = Range("Hard_Indirect_Benefits_Title").Text
'Set Text Frame as bulleted
With slideText.TextFrame.TextRange.ParagraphFormat.Bullet
.Visible = True
.Character = 8226
End With
'Text Lead In
slideText.TextFrame.TextRange.Text = Range("Hard_Indirect_Benefits_Lead_In").Text & vbNewLine
'Loop through Bulleted List
For Each Cell In Range("Hard_Indirect_Benefits_Bullets")
slideText.TextFrame.TextRange.InsertAfter Cell.Value & vbNewLine
'Adjust indents
With slideText.TextFrame.TextRange
.Lines(Start:=1, Length:=1).ParagraphFormat.Bullet = msoFalse
.Lines(Start:=3, Length:=1).IndentLevel = 2
End With
End With
'| Slide Soft Indirect Benefits |
'Set variables
With myPresentation.Slides(Range("Soft_Indirect_Benefits").Value)
Set TitleShape = .Shapes.Title
Set slideText = .Shapes(1)
'Title of Slide
TitleShape.TextFrame.TextRange.Text = Range("Soft_Indirect_Benefits_Title").Text
'Set Text Frame as bulleted
With slideText.TextFrame.TextRange.ParagraphFormat.Bullet
.Visible = True
.Character = 8226
End With
'Text Lead In
slideText.TextFrame.TextRange.Text = Range("Soft_Indirect_Benefits_Lead_In").Text & vbNewLine
'Loop through Bulleted List
For Each Cell In Range("Soft_Indirect_Benefits_Bullets")
If Cell.Value <> 0 Then
slideText.TextFrame.TextRange.InsertAfter Cell.Value & vbNewLine
End If
'Adjust indents
With slideText.TextFrame.TextRange
.Lines(Start:=1, Length:=1).ParagraphFormat.Bullet.Visible = False
.Lines(Start:=3, Length:=1).IndentLevel = 2
End With
End With
'********************************
'Save PRESENTATION
fileNameString = "C:\Users\johnDoe\Desktop\TheFile.pptx"
myPresentation.SaveCopyAs fileNameString, 1
'********************************
'CLEAN UP
myWorkbook.Worksheets("Embed").Visible = xlVeryHidden 'Hide the embedded file worksheet again
myWorkbook.Worksheets("Results").Select 'Select summary worksheet
Application.ScreenUpdating = True 'Screen updating on
End Sub
Hi Shrivallabha - thanks for your reply.
The path does exist, and it is hard coded in the sub.
Doole
Have you checked this link ?
http://www.mrexcel.com/forum/excel-...isual-basic-applications-save-powerpoint.html
Narayan
