Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

In Access - Save a .ppt as a .pps

Status
Not open for further replies.

snayjay

Programmer
Oct 23, 2001
116
US
On my form I have code that takes data from a table and creates a .ppt based on a template (filling in the data from the table). Right now I have it where a form comes up and there is a button on it. I click the button and it does everything. Then I have to alt-tab to the .ppt and go thru the menu to save it as a .pps. Is there anyway I can (thru VB code) save it as a .pps then close the template?
 
snayjay,

Look at the code behind your "button" as this opens PP and updates the information you should be able to extend it to include a "filesave" & "fileexit". If I recall correctly this is macrocode vs VBScript.

rvnguy
"I know everything..I just can't remember it all
 
Cann ´t you just rename it ?

Name ("C:\myPowerPointFile.ppt") As ("C:\myPowerPointFile.pps")
 
JerryKlmns,

I'm opening a template and filling in the data with my recordset information. If I rename, it would rename my template...no? I don't want to do that.

rvnguy,

Maybe looking at my code would be better

Code:
Private Sub cmdPowerPoint_Click()
'--- declare any required objects and variables
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppCurrentSlide As PowerPoint.Slide
'--- open powerpoint and set a pointer from Access to it
Set ppApp = CreateObject("PowerPoint.Application")
'--- make it visible on your monitor
ppApp.Visible = True
'--- open the pre-designed template
Set ppPres = ppApp.Presentations.Open("C:/METRICS.ppt")
Dim x
x = 0
Recordset.MoveFirst
Do Until Recordset.EOF
    x = x + 1
'**********First Slide of data************'
'--- set a pointer to the first slide in the presentation
    Set ppCurrentSlide = ppPres.SLIDES(x)
'--- assign a custom string of text to the slide title
    ppCurrentSlide.Shapes("UnitName").TextFrame.TextRange.Text = UnitName.Value
    ppCurrentSlide.Shapes("UnitName").TextFrame.TextRange.Text = UnitName.Value
    ppCurrentSlide.Shapes("AsOfDate").TextFrame.TextRange.Text = Format(AsOfDate.Value, "Medium Date")
    ppCurrentSlide.Shapes("Assigned").TextFrame.TextRange.Text = Assigned.Value
    ppCurrentSlide.Shapes("Overall").TextFrame.TextRange.Text = Overall.Value
    ppCurrentSlide.Shapes("OverallP").TextFrame.TextRange.Text = OverallP.Value
    ppCurrentSlide.Shapes("PHA").TextFrame.TextRange.Text = PHA.Value
    ppCurrentSlide.Shapes("PHAP").TextFrame.TextRange.Text = PHAP.Value
    ppCurrentSlide.Shapes("Dental").TextFrame.TextRange.Text = Dental.Value
    ppCurrentSlide.Shapes("DentalP").TextFrame.TextRange.Text = DentalP.Value
    ppCurrentSlide.Shapes("Immunizations").TextFrame.TextRange.Text = Immunizations.Value
    ppCurrentSlide.Shapes("ImmunizationsP").TextFrame.TextRange.Text = ImmunizationsP.Value
    ppCurrentSlide.Shapes("LabTests").TextFrame.TextRange.Text = LabTests.Value
    ppCurrentSlide.Shapes("LabTestsP").TextFrame.TextRange.Text = LabTestsP.Value
    ppCurrentSlide.Shapes("MaskFitTest").TextFrame.TextRange.Text = MaskFitTest.Value
    ppCurrentSlide.Shapes("MaskFitTestP").TextFrame.TextRange.Text = MaskFitTestP.Value
    ppCurrentSlide.Shapes("Inserts").TextFrame.TextRange.Text = Inserts.Value
    ppCurrentSlide.Shapes("InsertsP").TextFrame.TextRange.Text = InsertsP.Value
    ppCurrentSlide.Shapes("NotonProfile").TextFrame.TextRange.Text = NotonProfile.Value
    ppCurrentSlide.Shapes("NotonProfileP").TextFrame.TextRange.Text = NotonProfileP.Value
    ppCurrentSlide.Shapes("OccHealth").TextFrame.TextRange.Text = OccHealth.Value
    ppCurrentSlide.Shapes("OccHealthP").TextFrame.TextRange.Text = OccHealthP.Value
    ppCurrentSlide.Shapes("CATM").TextFrame.TextRange.Text = CATM.Value
    ppCurrentSlide.Shapes("CATMP").TextFrame.TextRange.Text = CATMP.Value
    ppCurrentSlide.Shapes("CWDT").TextFrame.TextRange.Text = CWDT.Value
    ppCurrentSlide.Shapes("CWDTP").TextFrame.TextRange.Text = CWDTP.Value
    ppCurrentSlide.Shapes("SABC").TextFrame.TextRange.Text = SABC.Value
    ppCurrentSlide.Shapes("SABCP").TextFrame.TextRange.Text = SABCP.Value
    ppCurrentSlide.Shapes("Fitness").TextFrame.TextRange.Text = Fitness.Value
    ppCurrentSlide.Shapes("FitnessP").TextFrame.TextRange.Text = FitnessP.Value
    ppCurrentSlide.Shapes("LegalReadiness").TextFrame.TextRange.Text = LegalReadiness.Value
    ppCurrentSlide.Shapes("LegalReadinessP").TextFrame.TextRange.Text = LegalReadinessP.Value
    ppCurrentSlide.Shapes("UNITTOTAL").TextFrame.TextRange.Text = UNITTOTAL.Value
    ppCurrentSlide.Shapes("UNITTOTALP").TextFrame.TextRange.Text = UNITTOTALP.Value
    ppCurrentSlide.Shapes("UNITCOMMENTS").TextFrame.TextRange.Text = UNITCOMMENTS.Value
    Recordset.MoveNext
Loop
'--- remove the pointers from memory
    Set ppApp = Nothing
    Set ppPres = Nothing
    Set ppCurrentSlide = Nothing
End Sub

I got the code from another access website... I tried to handjam the line that reads:

Set ppPres = ppApp.Presentations.Open("C:/METRICS.ppt")

I thought this was the line you were referring to, to see if there were other parameters available for saving. But didn't see any. Any help would be appreciated. Thanks in advance,

~Jeff
 
The first line should save it, the second close it. Place them just before you remove the pointers from the memory

ppPres.SaveAs ("C:\NewMETRICS.pps")
ppPres.Close

And set them to Nothing in reverse order!
 
snayjay,

JerryKlmns pointed you to exactly what I suggested in my initial post.
Look at the code behind your "button" as this opens PP and updates the information you should be able to extend it to include a "filesave" & "fileexit"

Albeit this appears as VB & not macrocode a I first surmised.

rvnguy
"I know everything..I just can't remember it all
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top