Expiring Today—Celebrate National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17


VBA Powerpoint create new presentation, insert presentation from other location

Posted on 2016-08-16
Medium Priority
Last Modified: 2016-09-12
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.
Question by:Hakum
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
LVL 18

Expert Comment

ID: 41757504
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

Author Comment

ID: 41757623
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.
LVL 18

Expert Comment

ID: 41757688
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?
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.


Author Comment

ID: 41759440
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
LVL 18

Accepted Solution

xtermie earned 2000 total points (awarded by participants)
ID: 41760648
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

LVL 18

Assisted Solution

xtermie earned 2000 total points (awarded by participants)
ID: 41760652
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.
LVL 18

Expert Comment

ID: 41762107
did that work for you? :)

Author Comment

ID: 41767090
Sorry Really swumped with workload, so this has sadly been priorytiesed.. Will get back asap!!! thank you for your understanding! :)
LVL 18

Expert Comment

ID: 41793891
Good comment and suggestions provided but not feedback on final output or points awarded by the author

Featured Post

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I was prompted to write this article after the recent World-Wide Ransomware outbreak. For years now, System Administrators around the world have used the excuse of "Waiting a Bit" before applying Security Patch Updates. This type of reasoning to me …
Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …

718 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question