Improve company productivity with a Business Account.Sign Up

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

VBA Powerpoint create new presentation, insert presentation from other location

Hi guys,

I refer to my previous question:

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.
  • 6
  • 3
2 Solutions
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
End Sub

Same changes for pres2
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.
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?
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

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
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
        With otarget.Slides.Paste(otarget.Slides.Count + 1)
        .Design = oDonor.Slides(i).Design
        .ColorScheme = oDonor.Slides(i).ColorScheme
    End With
    Next i
Set oDonor = Nothing
sFileName = Dir()
Exit Sub
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()
If UBound(names) > 1 Then
    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
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
        If .SelectedItems.Count <> 0 Then
            PickDir = .SelectedItems(1)
        End If
    End With

End Function

Open in new window

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.
did that work for you? :)
HakumAuthor Commented:
Sorry Really swumped with workload, so this has sadly been priorytiesed.. Will get back asap!!! thank you for your understanding! :)
Good comment and suggestions provided but not feedback on final output or points awarded by the author
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

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