Originally Posted by
June7
Probably need code to open the two PP files. I have only done that with Excel files but I expect would be much the same. Select VBA reference: Microsoft PowerPoint 12.0 Object Library
This works:
Sub PP()
Dim oPP As PowerPoint.Application
Dim oPP1 As PowerPoint.Presentation
Dim oPP2 As PowerPoint.Presentation
Set oPP = New PowerPoint.Application
oPP.Activate
Set oPP1 = oPP.Presentations.Open("C:\Temp\Test1.ppt")
Set oPP2 = oPP.Presentations.Open("C:\Temp\Test2.ppt")
oPP1.Slides(1).Copy
oPP2.Windows(1).Activate
oPP2.Slides.Paste
End Sub
Review
http://msdn.microsoft.com/en-us/libr...ffice.11).aspx
http://support.microsoft.com/kb/161661
I simply cannot find any more sample code for Access to interact with PowerPoint. Now you are on your own.
Code:
Dim bResult As Boolean
'Dim pptObj As PowerPoint.Application
Dim strCopyname As String
On Error GoTo ErrorHandler
Const CALLER As String = " Form_frmOOSTemplate:MakePPT "
' Open PowerPoint
bResult = True
Set mPPTobj = New Powerpoint.Application
mPPTobj.Visible = True
mPPTobj.WindowState = ppWindowMinimized
'default file names #1 Source fILE
If (IsNull(strPowerPointFile1) Or strPowerPointFile1 = vbNullString) Then
#If conbTest Then
strPowerPointFile1 = mstrTestOOSAV & "PP Service Template.ppt"
#Else
strPowerPointFile1 = mstrHymnbank & "PP Service Template.ppt"
#End If
End If
'#2 Destination file either test r normal environment
If (IsNull(strPowerPointFile2) Or strPowerPointFile2 = vbNullString) Then
#If conbTest Then
'testdir
strPowerPointFile2 = mstrTestOOSAV & "App2.pptx"
#Else
strPowerPointFile2 = mstrHymnbank & "App2.pptx"
#End If
End If
' Fill a collection with all Slide IDs. after opening the PP slide show
With mPPTobj.Presentations.Open(strPowerPointFile1)
Set mcolSlideIDs1 = New Collection
'Dim mppSlide As PowerPoint.Slide
'MsgBox (mPPTobj.Presentations.Item(strPowerPointFile).Slides.Item(1).SlideNumber)
For Each mppSlide In .Slides
mcolSlideIDs1.Add mppSlide.SlideID
'Copy??
' ppSlide.Copy
strCopyname = mppSlide.Name
Debug.Print strCopyname
'.Slides.Item (strCopyname)
Next
' .Close
End With
' Specify OLE Class, Type, SourceDoc, SourceItem and other properties.
With pptFrame
.Class = "Microsoft Powerpoint Slide"
.OLETypeAllowed = acOLELinked
.SourceDoc = strPowerPointFile1
End With
End Sub
Thanks for the "jump start". I have left out the code to enable the command btns for first/next/previous\Last slides to view on PP1. This works now I have to figure out why I have multiple PP presentations for PP1 and PP2 displayed.
Her is the code for COpy/paste
Code:
Dim intSlideNum As Integer
'mstrApp1 = mstrDropBox & mstrTestPath & "App1.pptx"
mstrApp1 = mstrDropBox & "John M Slides\" & "PP Service TEMPLATE.PPT"
mstrApp2 = mstrDropBox & mstrTestPath & "App2.pptx"
If IsFile(mstrApp1) And IsFile(mstrApp2) Then
'copy from 1 paste to 2
'first get #1 App's slideNum
intSlideNum = mlngSlideIndex1
If CopyPasteSlide(mstrApp1, mstrApp2, intSlideNum, 1) Then
'MsgBox ("Success")
UpdateChkBox (True)
Else
MsgBox ("failed")
UpdateChkBox (False)
End If
Else
MsgBox ("Enter correct file names" & vbNewLine & mstrApp1 & vbNewLine & mstrApp2)
UpdateChkBox (False)
End If
Here is code for Copy\Paste any slide as selected by user from a specified directory
Code:
If BrowseHymnFiles(strDirname, strHymn) Then
MsgBox ("Hymn = " & FileNameFromPath(strHymn))
mstrAppTmp = mstrApp1 'mstrDropBox & "John M Slides\PP Service Template.ppt"
mstrApp1 = strHymn 'mstrDropBox & "John M Slides\PP Service Template.ppt"
mstrApp2 = mstrDropBox & mstrTestPath & "App2.pptx" 'strDirName & FileNameFromPath(strHymn) 'chg 9/29/2012
'dup mstrAppTmp = mstrDropBox & "John M Slides\PP Service Template.ppt" 'Temp spot
'set the presentation #1 to the Hymn not to template pptx
If Not moPP1 Is Nothing Then
Set moPP1 = Nothing
End If
If IsFile(mstrApp1) And IsFile(mstrApp2) Then
If CopyPasteSlide(mstrApp1, mstrApp2, intSlideNum, 2) Then
'MsgBox ("Success")
UpdateChkBox (True)
'reset app names & object back
mstrApp1 = mstrAppTmp
'recreate presentation
If Not moPP1 Is Nothing Then
moPP1.Close 'chg 10/1/2012 added close of Hymn presentation
Set moPP1 = Nothing
Set moPP1 = mPPTobj.Presentations.Open(mstrApp1)
Else
Set moPP1 = mPPTobj.Presentations.Open(mstrApp1)
End If
Else
MsgBox ("failed")
UpdateChkBox (False)
End If
Else
MsgBox ("Enter correct file names" & vbNewLine & mstrApp1 & vbNewLine & mstrApp2)
UpdateChkBox (False)
End If
Else
End If