Solved

How do you close PowerPoint 2007 using VBA

Posted on 2009-07-15
13
1,029 Views
Last Modified: 2012-05-07
I am trying to close MS Powerpoint (2007) from vba in another presentation where i don't save the presentation.
What is the code I am supposed to run to close. When I close the presentation manually, ppt crashes.

Any suggestions or code are greatly welcome.
Thanks...
0
Comment
Question by:DekkaG
  • 5
  • 4
  • 2
  • +1
13 Comments
 
LVL 13

Expert Comment

by:game-master
ID: 24866210


good morning!

have you tried application.quit



game-master
0
 

Author Comment

by:DekkaG
ID: 24866626
I don't want to quit the application. Just the presentation. I have another presentation open in the app.
0
 
LVL 13

Expert Comment

by:game-master
ID: 24866644


try this one....

SlideShowWindows(Index:=1).View.Exit


this will close the specific presentation
0
 

Author Comment

by:DekkaG
ID: 24866918
i got the following run time error:
-2147188160 (80048240)
slideshowwindows(unknown member): integer out of range. 1 is not in the valid range of 1 to 0.

Never seen this one before. I would have thought that 1 is in that range....

Getting close i'm feeling....
0
 
LVL 13

Expert Comment

by:game-master
ID: 24866974


can u post your code?

change the index number '1' to the index number of your slide..

SlideShowWindows(Index:=1).View.Exit



game-master
0
 
LVL 13

Expert Comment

by:game-master
ID: 24867031


try this one...

If SlideShowWindows.Count > 0 Then
        SlideShowWindows(SlideShowWindows.Count).View.Exit
    End If

the error occur when your trying to exit the slideshow but either there no
active slideshow or your having an incorrect index..


game-master
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 23

Expert Comment

by:JSRWilson
ID: 24868386
Try

Presentations("name.pptx").Close

Obviously substitue the name of the actual presentation.
0
 

Author Comment

by:DekkaG
ID: 24869914
I am attaching the code I am using right now. Hopefully this will help.
JSRWilson, I have tried using that method but a dialog box opens up to ask me whether i want to save the file. Is there a way to say no or not have that box pop up?


Sub PullExcelData()

    

    mbErrorSwitch = False

    Set objWorksheet = objWorkbook.Worksheets("QueryMap")

    PresName = objWorksheet.Range("nrPresName").Value

    strPresPath = WKBKPATH & PresName

    oPPTObjName = objWorksheet.Range("nrObjName").Value

    

    Application.DisplayAlerts = False

    

    'Open the presentation

    Presentations.Open (strPresPath)

    'Set oPPTApp = CreateObject("Powerpoint.Application")

    Set objPresentation = ActivePresentation

    Set objSlide = objPresentation.Slides(1)

    

'    Set objexcel = CreateObject("Excel.Application")

'    objexcel.Visible = False

    

'    Set objWorkbook = objexcel.Workbooks.Open(ActivePresentation.Path & "\Connection Script1.2.xlsm")

    Set objWorksheet = objWorkbook.Worksheets("Main")

    Set objRange = objWorksheet.Range("nrMainCopyRange")

    

    'Instantiate the workbook object from the OLE object

    Set objExcelDestWb = objSlide.Shapes(oPPTObjName).OLEFormat.Object

    

    'Define what worksheet to paste into

    Set objExcelDestSheet = objExcelDestWb.Worksheets(1)

    

    'Optionally clear destination sheet, depends what you are updating..

    objExcelDestSheet.Cells.ClearContents

    objWorksheet.Activate

    objRange.Copy

    

    'PASTE INTO EXCEL TABLE at cell A1

    objExcelDestSheet.Paste objExcelDestSheet.Range("A1")

        

   ' AutoFitColumns

    Dim mvgRng As Range

    With objExcelDestSheet

        .Columns("C:Z").AutoFit

    End With

    

    objExcelDestSheet.Range("A1").EntireColumn.ColumnWidth = 50

    Set mvgRng = objExcelDestSheet.Range("B1:Z1")

    

    For Each c In mvgRng.Cells

        

        If c.EntireColumn.ColumnWidth > 30 Then

            c.EntireColumn.ColumnWidth = 30

        Else: End If

    Next c

 

    objExcel.CutCopyMode = False

    Application.DisplayAlerts = True

        

    On Error Resume Next

    Set oPPTShape = objPresentation.Slides(1).Shapes("txtAsOfDate")

        Set objWorksheet = objWorkbook.Worksheets("SysConfig")

        oPPTShape.TextFrame.TextRange.Text = "As of " & objWorksheet.Range("nrCharDateDisplay").Value

    

    Set oPPTShape = objPresentation.Slides(1).Shapes("txtFootnote")

        Set objWorksheet = objWorkbook.Worksheets("Other")

        oPPTShape.TextFrame.TextRange.Text = objWorksheet.Range("nrFootnote").Value

    

'    oPPTApp.Visible = True

'    SlideCopy2

 

            Dim s As Slide

            Dim vt As Long

            

            On Error GoTo slideError

            

            Presentations.Add

            Set objPresentation2 = ActivePresentation

 

            vt = objPresentation2.Windows(1).ViewType

           objPresentation2.Windows(1).ViewType = ppViewOutline

            For Each s In objPresentation.Slides

                s.Copy

                Set cl = s.CustomLayout

                objPresentation2.Slides.Paste

                objPresentation2.Slides(objPresentation2.Slides.Count).CustomLayout = cl

            Next s

            objPresentation2.Windows(1).ViewType = vt

  

'    objPresentation.Windows(1).Activate

'    SlideShowWindows(Index:=1).View.Exit

'    objPresentation.Windows(1).Close

    

    

'    With Application.objPresentation

'        .Saved = True

'        .Close

'    End With

   

        Exit Sub

        

slideError:

     

End Sub

Open in new window

0
 
LVL 23

Expert Comment

by:JSRWilson
ID: 24870728
Set the Saved flag to True?

With Presentations("notestest.pptx")
.Saved = msoTrue
.Close
End With
0
 

Author Comment

by:DekkaG
ID: 24871427
JSRWilson,
I added that to the bottom of my code, but now PPT is totally crashing on the .Close

Here is the error i am getting.

Run-time error -2147417848 (80010108)
Automation Error
The object invoked has disconnected from its clients.
0
 

Author Comment

by:DekkaG
ID: 25576250
The only way i am able to do this is to save the file to my temp path. Then i can close the presentation without it crashing.
0
 

Accepted Solution

by:
ee_auto earned 0 total points
ID: 25928334
Question PAQ'd, 500 points refunded, and stored in the solution database.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Background   Certain code in VBA requires initialization, such as application events. The app initialization is often triggered by the Auto_Open sub which is a special procedure that runs when an add-in loads. More significantly, this sub does n…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
This video teaches viewers how to fit pictures into slides, crop and remove backgrounds, and alter photos to look more professional.
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

932 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now