Solved

VBA Powerpoint create new presentation, insert presentation from other location

Posted on 2016-08-16
9
24 Views
Last Modified: 2016-09-12
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
Comment
Question by:Hakum
  • 6
  • 3
9 Comments
 
LVL 18

Expert Comment

by:xtermie
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
Next
End Sub

Same changes for pres2
0
 
LVL 1

Author Comment

by:Hakum
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.
0
 
LVL 18

Expert Comment

by:xtermie
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?
0
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 
LVL 1

Author Comment

by:Hakum
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
0
 
LVL 18

Accepted Solution

by:
xtermie earned 500 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
        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
 
LVL 18

Assisted Solution

by:xtermie
xtermie earned 500 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.
0
 
LVL 18

Expert Comment

by:xtermie
ID: 41762107
did that work for you? :)
0
 
LVL 1

Author Comment

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

Expert Comment

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

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

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

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
My experience with Windows 10 over a one year period and suggestions for smooth operation
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

810 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