• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 214
  • Last Modified:

VBA Powerpoint create new presentation, insert presentation from other location

Hi guys,

I refer to my previous question:
https://www.experts-exchange.com/questions/28962802

But i need some help since its not working properly, its simply not working for me if i have more then 1 presentation.. it only add's the last presentation in that is in the code..

Sub create_new_ppt()

    Dim myPresentation As Presentation

    Set myPresentation = Presentations.Add(WithWindow:=msoFalse) 'hidden
    'Set myPresentation = Presentations.Add(WithWindow:=msoTrue) 'visible
    
    
    'Import Presentation
    If crtppt.chk_pres1.Value = True Then
        sTemplate = "c:\test\Test import2.pptx"  '16:9 format
        'Call pres1
    End If

    If crtppt.chk_pres2.Value = True Then
        sTemplate = "c:\test\Test import3.pptx"  '4:3 format
        'Call pres2
    End If
           
    Set myPresentation = Presentations.Open(sTemplate, False, True, True)
    
    'Insert Title
    If crtppt.txt_header > "" Then
        Call Module2.add_title
    End If
    
    'Insert Subtitle
    If crtppt.txt_subtitle > "" Then
        Call Module2.add_subtitle
    End If
    
    
    ' Set Format
    If crtppt.opt_format4x3 = True Then
        Call Module2.pageformat_4x3
    End If
    
    If crtppt.opt_format16x9 = True Then
        Call Module2.pageformat_16x9
    End If
       
    
End Sub

Open in new window


here is the file i will convert to a ppam later on.
ppt-tool-16082016.ppt
0
Hakum
Asked:
Hakum
  • 6
  • 3
2 Solutions
 
xtermieCommented:
Your issue is that both subs pres1 and pres2 only look for a specific pptx
you need to enumerate the folder for all ppts in the test folder

Try these instead:

Private Sub pres1()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\test")
Set colFiles = objFolder.Files
For Each objFile In colFiles
    If Right(objFile.Name, 3) = "ppt" Or Right(objFile.Name, 4) = "pptx" Then
        mypptfile = "C:\test\" & objFile.Name
        ActivePresentation.Slides.InsertFromFile mypptfile, 0
    End If
Next
End Sub

Same changes for pres2
0
 
HakumAuthor Commented:
hmmm... not exactly what i had in mind since the presentations can be located at various location in other words the presentation can be located at different drives or network locations.. and you chose what to import by the checkbox from the userform, maybe i wasn't able to make myself clear sorry for that.

How it works is that the userform is launched and the user choose from a list of checkboxes which presentation should be consolidated and then it builds the presentation from the checkbox values.
0
 
xtermieCommented:
ok, I c...but it looks that you have every check set to a defined presentation. That can't be that dynamic.
Just to clarify, you want your form with check boxes (the one you have now) to be used to create a new presentation with a particular template, and then choose which presentation(s) content to be imported to that NEW presentation, correct?
An idea would be to create a different part on the existing form that will be populated by all available presentations in your system or specified drives/network locations and then choose which to insert to the new presentation ; however, given that you have different formats, there may be a need to distinguish presentations listed as 4:3 or 16:9 and allow only import of similar sized/formatted presentations.  How does that sound?
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
HakumAuthor Commented:
it was just a sample file,

this tool has 2 purposes 1) to create new presentation useing a theme or a template, 2)  to merge 1 to 10 presentations into a new presentation not needed to use a specific template or theme.

The presentations is handle by various departments and have diffrent working folders and therefore not a easy way to get all those presentation into one single folder.

The presentation format is not that important for the presentation that is merged.

I simply need a way to combine/merge/put together 1 to 10 presentations into a 1 single presentation
0
 
xtermieCommented:
Ok, could you:
1) Copy all these presentations to a single folder prior to running the macro?
2) Know the different addresses of all presentations?
3) Want to type the address of the presentation each time?

In case of 1 you can create your presentation using your existing macro and then run either of the following, depending if the order of the presentation's to be imported is imported (and need to be sorted).
Option 1 - insert all presentations from a specific folder into the existing one:
Sub PPTJoiner()
'To use place a copy of all of the presentations EXCEPT the first in a folder on your desktop called "joiner" (no quotes)
'Open the first presentation (Make sure you use a COPY) and press Alt f11 to open the vbe editor. INSERT > Module and paste in this code
Dim sFileTyp As String
Dim sFileName As String
Dim oDonor As Presentation
Dim otarget As Presentation
Dim i As Integer
On Error GoTo errhandler
sFileTyp = "*.PPT" ' change this for .pptx or pps

sFileName = Dir$(Environ("USERPROFILE") & "\Desktop\joiner\" & sFileTyp)
Set otarget = ActivePresentation
Do While sFileName <> ""
    Set oDonor = Presentations.Open(Environ("USERPROFILE") & "\Desktop\joiner\" & sFileName, msoFalse)
    For i = 1 To oDonor.Slides.Count
        oDonor.Slides(i).Copy
        With otarget.Slides.Paste(otarget.Slides.Count + 1)
        .Design = oDonor.Slides(i).Design
        .ColorScheme = oDonor.Slides(i).ColorScheme
    End With
    Next i
oDonor.Close
Set oDonor = Nothing
sFileName = Dir()
Loop
Exit Sub
errhandler:
MsgBox "Sorry, there was an error"
End Sub

Open in new window


Option B - insert all presentations from a specific folder, sorted by name:
Sub PPTJoiner2()
'If the order of files is important this second method sorts the files alphabetically before inserting slides.
'To use place a copy of all of the presentations EXCEPT the first in a folder on your desktop called "joiner" (no quotes)
'Open the first presentation (Make sure you use a COPY) and press Alt f11 to open the vbe editor. INSERT > Module and paste in this code
Dim strName As String
Dim names() As String
Dim otarget As Presentation
Dim osource As Presentation
Dim i As Long
Dim j As Long
Dim strBuffer1 As String
Dim strFolder As String
Set otarget = Presentations.Add
ReDim names(1 To 1)
strFolder = Environ("USERPROFILE") & "\Desktop\joiner\"
strName = Dir$(strFolder & "*.PPTX")
While strName <> ""
    names(UBound(names)) = strName
    ReDim Preserve names(1 To UBound(names) + 1)
    strName = Dir()
Wend
If UBound(names) > 1 Then
    'sort
    For i = 1 To UBound(names) - 1
        For j = (i + 1) To UBound(names) - 1
            If UCase(names(i)) > UCase(names(j)) Then
                strBuffer1 = names(j)
                names(j) = names(i)
                names(i) = strBuffer1
            End If
        Next
    Next
End If

If UBound(names) > 0 Then
    For i = 1 To UBound(names) - 1
        otarget.Slides.InsertFromFile strFolder & names(i), otarget.Slides.Count
    Next i
End If
End Sub

Open in new window


For (3) you can have code that asks of the directory where presentations to be merges are, each time, and then imports those presentations to the current presentation:

Private Function PickDir() As String
Dim FD As FileDialog

    PickDir = ""

    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .Title = "Pick a directory to work on"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 0 Then
            PickDir = .SelectedItems(1)
        End If
    End With

End Function

Open in new window

1
 
xtermieCommented:
and for (3) in your macro that combines PPTs you should have something like:
SrcDir = PickDir()

Open in new window

where SrcDir would invoke the select folder window and maintain your selection as the destination folder.
0
 
xtermieCommented:
did that work for you? :)
0
 
HakumAuthor Commented:
Sorry Really swumped with workload, so this has sadly been priorytiesed.. Will get back asap!!! thank you for your understanding! :)
0
 
xtermieCommented:
Good comment and suggestions provided but not feedback on final output or points awarded by the author
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now