Error when saving Powerpoint via VBA from Excel (Runtime error '-2147467259)

[doodle]

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!

Sub CreateClientPresentationTest()

Dim rng As Range
Dim ppApp As Object
Dim myPresentation As Object
Dim Cell As Range
Dim cellvalue As String
Dim SlideNum As Integer
Dim dlgSaveAs As FileDialog

Application.ScreenUpdating = False

'********************************
'SET UP

'| Set variable for the current open Excel tool |
    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
        Next
   
        '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
        Next
   
        '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
                                         
                Else
               
            End If
        Next
   
        '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

 

[shrivallabha]

Does this path exist on user computer?
"C:\Users\johnDoe\Desktop"
Is it hard coded as you have posted?

 

[doodle]

Hi Shrivallabha - thanks for your reply.

The path does exist, and it is hard coded in the sub.

Doole

 

[NARAYANK991]

Hi ,

Have you checked this link ?

http://www.mrexcel.com/forum/excel-...isual-basic-applications-save-powerpoint.html

Narayan