Opening saved excel document and resetting powerpoint to first slide in presentation mode using VBA

Excel Novice Darren

New Member
Joined
Nov 4, 2015
Messages
1
Hi all ,

I'm using Windows 7 and Office 2010

I am brand new to VBA I have used this site to find code for certain applications and up until now I have always found an answer.

I am creating an Company Induction on Powerpoint. When the Inductee gets to the end of the induction I have used an action button linked to an excel document where they fill in their details. I have then used a VBA code found on here to send the excel document to an email recipient using Lotus Notes and automatically close Excell.

To finish off I would like to add code to go back to the first slide in the induction powerpoint presentation (which should be open) in presentation mode, however I would also like to open the powerpoint at the first slide in presentation mode if for some reason it has been closed.

I have included my entire code for the excel document and as you will see I get the powerpoint to open in presentation mode on the first slide but once powerpoint is open when I run this code again it goes back to the final slide not the first slide.

Hope this makes sense?

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454
Const stPath As String = "P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\"
Const vaMsg As Variant = "Please save this document in a folder identified with the company name and use the surname followed by forename as the document name." & vbCrLf & _
"Kind regards," & vbCrLf & _
"Induction System"
Const vaCopyTo As Variant = "email address"
Sub Send_Active_Sheet1()

Dim stFileName As String
Dim vaRecipients As Variant

Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String

'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = "New Inductee for processing"
End With

stAttachment = stPath & "New inductee for processing.xlsm"

MsgBox "Select YES when asked if you would like to replace the existing document", vbInformation

'Save and close the temporary workbook.
With ActiveWorkbook
ChDir "P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\"
ActiveWorkbook.SaveAs Filename:= _
"P:\Toton Business Improvements\Contractor Management\Full Induction\TEMP\New Inductee for processing.xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
End With

'Create the list of recipients.
'vaRecipients = VBA.Array("email address", "email address")

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.CopyTo = vaCopyTo
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With

'Delete the temporarily workbook.

'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "The e-mail has successfully been created and distributed", vbInformation


Dim myPPAppObj As PowerPoint.Presentation
Set myPPAppObj = GetObject("P:\Toton Business Improvements\Contractor Management\Company.pptm")
'Add your path and file in above!

myPPAppObj.SlideShowSettings.Run

ActiveWorkbook.Close SaveChanges:=False
End Sub

Can anyone please help!!
 
Last edited:

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

Forum statistics

Threads
1,148,250
Messages
5,745,645
Members
423,965
Latest member
visionquest1972

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top