Macro to generate powerpoint slides

[Marty Girvan]

I started a thread in the MS EXCEL and VBA MACROS group. My post in their group has a sample folder with all necessary files. here is a link to test and play with it. Thanks.

https://groups.google.com/forum/#!topic/excel-macros/-ZintzqwKD8

 

[GS]

I am already on it. We are close, but missing a open hyperlink

function of some sort.

I don't understand why you think you need hyperlinks. Everything I
coded for just requires a full path...

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

I started a thread in the MS EXCEL and VBA MACROS group. My post in

their group has a sample folder with all necessary files. here is a
link to test and play with it. Thanks.

https://groups.google.com/forum/#!topic/excel-macros/-ZintzqwKD8

Got it working with the followig code...

Option Explicit

Sub CreatePPT()
Dim vList, n&, oPres

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

I started a thread in the MS EXCEL and VBA MACROS group. My post in

their group has a sample folder with all necessary files. here is a
link to test and play with it. Thanks.

https://groups.google.com/forum/#!topic/excel-macros/-ZintzqwKD8

Got this code working in PPT...

Option Explicit


Sub InsertSlidesFromFile()
' Inserts slides from a list of PPTs stored in a txt file
Dim vList, n&, oPres, oDlg, vFile, sFile$

Set oDlg = Application.FileDialog(msoFileDialogOpen)
With oDlg.Show
On Error Resume Next
vFile = oDlg.SelectedItems(1)
On Error GoTo 0
End With
sFile = IIf(vFile = Empty, "", CStr(vFile))
If sFile = "" Then goto cleanup

vList = Split(ReadTextFile(sFile), vbCrLf)
On Error GoTo Cleanup
'Add a new presentation
Set oPres = Presentations.Add
With oPres.Slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n), .Count
Next 'n
End With 'oPres.slides

Cleanup:
Set oDlg = Nothing: Set oPres = Nothing
End Sub

Sub InsertSlidesFromFolder()
' Inserts slides from a list of PPTs stored in a txt file
Dim vFile, n&, oPres, sPath$

sPath = GetDirectory: If sPath = "" Then Exit Sub
sPath = IIf(Right(sPath, 1) <> "\", sPath & "\", sPath)

vFile = Dir(sPath)
On Error GoTo Cleanup
'Add a new presentation
Set oPres = Presentations.Add
With oPres.Slides
'Insert the slides into the presentation
Do While Len(vFile)
.InsertFromFile sPath & vFile, .Count
vFile = Dir()
Loop
End With 'oPres.slides

Cleanup:
Set oPres = Nothing
End Sub

Function ReadTextFile$(Filename$)
' Reads large amounts of data from a text file in one single step.
Dim iNum%
On Error GoTo ErrHandler
iNum = FreeFile(): Open Filename For Input As #iNum
ReadTextFile = Space$(LOF(iNum))
ReadTextFile = Input(LOF(iNum), iNum)

ErrHandler:
Close #iNum: If Err Then Err.Raise Err.Number, , Err.Description
End Function 'ReadTextFile()

Function GetDirectory$(Optional OpenAt, Optional Msg$)
' Returns the path of a user selected folder
' Note: By default, dialog opens at 'Desktop'
' Args:
' OpenAt Optional: Path to the dialog's top level folder
' Msg Optional: The dialog's title

If Msg = "" Then Msg = "Please choose a folder"
On Error Resume Next '//if user cancels
GetDirectory = CreateObject("Shell.Application").BrowseForFolder(0,
Msg, &H40 Or &H10, OpenAt).Self.Path
End Function 'GetDirectory()

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[isabelle]

hi,

Le 2014-08-27 13:38, Marty Girvan a écrit :

I am already on it. We are close, but missing a open hyperlink function of some sort.

Sub appPPT()
Dim oPPT As PowerPoint.Application
Dim oPres As PowerPoint.Presentation
Dim oSlide As PowerPoint.Slide
Dim oShape As PowerPoint.Shape

Set oPPT = CreateObject("PowerPoint.Application")
Set oPres = oPPT.Presentations.Add(msoTrue)
Set oSlide = oPres.Slides.Add(1, ppLayoutBlank)
Set oShape = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 256, 28)

With oShape.TextFrame.TextRange
.Text = "http//www.google.com"
.ActionSettings(ppMouseClick).Hyperlink.Address = "http://www.google.com/"
End With

oPPT.Visible = msoTrue
End Sub

isabelle

 

[isabelle]

note that the Hyperlinks work only while a slide show presentation is running —
not while you're working on your presentation in normal view or slide sorter view

isabelle

Le 2014-08-27 22:13, isabelle a écrit :

 

[Marty Girvan]

My apologies as I have been in a training till now. I am going to integrate your code, Gary and Isabella. I am excited to try it. Thanks. I'll post my results.

 

[Marty Girvan]

Isabella,


Thank you for the code and reply. Looking a the code, I think it misses the idea of automating the hyperlinks opening automatically from a excel file.. If I understand your code correctly, then I would need to add all 150 links to the code. Let me know if this is what you are referring to. Thanksagain.

Marty

 

[isabelle]

hi Marty,

do you want add to your presentation a link to view the excel file that contains
file links (pptx)

With oShape.TextFrame.TextRange
.Text = "PPTX Links Address"
With .ActionSettings(ppMouseClick).Hyperlink
.Address = "C:\Users\isabelle\PPTX Links Address.xlsm"
.SubAddress = "Sheet2!A1"
End With
End With

or do you want add these links directly in your presentation (150 textbox)

isabelle

Le 2014-08-29 19:57, Marty Girvan a écrit :

Isabella,


Thank you for the code and reply. Looking a the code, I think it misses the idea of automating the hyperlinks opening automatically from a excel file.
If I understand your code correctly, then I would need to add all 150 links to

the code. Let me know if this is what you are referring to. Thanks again.

 

[Marty Girvan]

Isabelle,

I have a excel file with 150 hyperlinks (A1:A150). Each hyperlink points to a single PowerPoint slide. Each slide is in a different folder on different servers. These files ate updated daily by engineers. I need to find a way to open them all and have them automatically build a presentation with all 150 slides so that I can present it on a weekly basis. If you read through all the above posts. There is more detailed info as to how we are trying to build this VBA code. Thanks again for taking the time to problem solve and help create. Its fun.

Marty

 

[Marty Girvan]

I was able to get both the excel code to work and the PowerPoint code to work. However, I found that if a link is missing or broken the code will onlyshow the slides till the broken/missing link. We need something that willcheck all the links first and highlight the ones that ate broken, then maybe a text box that asks to compile and generate the presentation. This wayyou can fix the links first (highlighted) and then compile.

Here is the code I currently use to check the links.

 

[Marty Girvan]

Opps, I forgot the code:

Sub Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("Links").Range("J2:J105") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select

On Error GoTo 0 'Resume error checking


End Function

 

[GS]

Isabelle,

I have a excel file with 150 hyperlinks (A1:A150). Each hyperlink
points to a single PowerPoint slide. Each slide is in a different
folder on different servers. These files ate updated daily by
engineers. I need to find a way to open them all and have them
automatically build a presentation with all 150 slides so that I can
present it on a weekly basis. If you read through all the above
posts. There is more detailed info as to how we are trying to build
this VBA code. Thanks again for taking the time to problem solve and
help create. Its fun.

Marty

The code samples I posted do *exactly* what you want both from Excel
and PPT if your list items point to UNC paths...

(ie: "//server/share/folder/file".

The code shows various ways to open all the files in a list stored in a
spreadsheet, text file, or individual folders.

The hardest part for me was not having any experience using PPT! (I can
make same presentations in Excel<g>, so no need to learn a different
software IMO! Same goes for Word!) But after you posted the download
link to sample files things just quickly 'fell together'!

What it does not do is download the fikes from the internet. That's
easy to do in VB[A], however, by just setting some references to the
necessary system DLLs to get it done.

You are (typically) piece-mealing us bits of your task requirements 'as
you go' and so 'it goes' that eventually things will come together once
all (or nearly all) of the requirements are known. For example.., the
samples' list hyperlinks to files stored locally, NOT across multiple
servers. None of my code requires 'hyperlinks' because it accesses
files directly via fully qualified paths. Download URLs aren't
hyperlinks either, ..they're just location paths to the files.

IMO, persisting to go on and on about trying to work with hyperlinks is
a deterring distraction away from getting a speady solution. The code
you posted for checking if a path/file is valid is normal practice for
accessing files. (Not to mention there's better ways to do it as well!)

Give us 'the goods, the whole goods, and nuthin' but the goods' and
we'll do our best to get you a good working solution!!!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Marty Girvan]

Garry,

Thanks again. I am back from Vaca and working on this again. No internet where I was at. Anyhow, I am still playing with the process and code and will update again tomorrow with some more info. I may send you my working folder if I can find the time and you can see where I am at. Thanks again. Cheers.

 

[Marty Girvan]

Okay, after spending a few days playing with the code and tweaking my files and organization a bit, this is what I have come up with.
What is needed and what is my process:

The Objective: Create a Power Point Presentation from 150 individual power point slides that are located on different servers. And to make sure that these files have a valid address with the option to change the address upon finding a broken link.

1. Each file is a PowerPoint slide that has its own unique address. (\\nwserver\data\folder xx\ slide1.pptx).

2. Each file is in a different folder and these files are updated by engineers on a daily basis.

3. Each file's address is saved in a excel sheet (A1:A150) that I manually update when new ones are made and old ones are removed.

4. Sometimes these files get renamed/moved to a different location and then it creates a broken address (hyperlink).

The outcome of this is that I need to generate a presentation a few times a week and right now it is manual. It takes hours if not days depending on the changes.

So far this code works with my current excel sheet:

Option Explicit
Sub Auto()

Dim vList, n&, oPres

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing
End Sub


It does exactly what it needs to do by opening up cells A1:A5 and reads the address that is located in each cell... (\\nwserver\data\folder xx\ slide1.pptx)

It then produces a PowerPoint presenation with the slides in order as they are in the excel sheet.

What it does not do:

It does not find the Broken Links first and then creates a text box to the new location for that file. What happens is it stops showing the next slides in the presentation when one of the links is broken.

Also, if a individual slide has formatting it does not show up in the processed PowerPoint presentation. Its as if it does not load the formatting for the slides.

So next steps would be to:

incorporate my macro for checking the links into the new code:

Sub FourSQ_Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("4SQ Links").Range("J2:J114") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select








In the above code a change would need to be made to incorporate a text box that allows a folder/file search to change the location of the dead link.

So now the new code would look something like this:

Sub CheckThenAuto()

' Find Dead Hyperlinks
Dim c As Range
Dim vList, n&, oPres

'CHANGE - Here you will need to change the name of the worksheet you want and the range of cells to check
For Each c In Worksheets("Sheet1").Range("A1:A5") 'Change range to suit

If c.Value = "" Then End

If FileExists(c.Hyperlinks(1).Address) = "False" Then

With c.Interior 'Color cell with dead link Yellow
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
End With

End If
Next

MsgBox "Check Complete"

vList = ActiveSheet.Range("A1:A5")
On Error GoTo Cleanup
'Automate a new instance of PowerPoint
' Set appPPT = CreateObject("PowerPoint.Application")
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing

End Sub

Function FileExists(PathName As String) As Boolean

Dim Temp As Integer

On Error Resume Next 'Ignore errors

Temp = GetAttr(PathName)

Select Case Err.Number 'Check if error exists and set response
Case Is = 0
FileExists = True
Case Else
FileExists = False
End Select

End Function


It needs a little work as the links are highlighted yellow. LOL but I am working on that now.


The next steps would be to add the text box and save keel the PowerPoint formatting while opening and inserting the files into the presentation.

Maybe the logic would look something like this: Original slide1.ppt file then Copy it and paste it into the presentation. Or paste special of some sort.

Keeping the formatting is the biggest set back right now.

Thanks for looking and the input.

 

[GS]

IMO, Marty, you're way over complicating! The following checks the list
for valid paths and if not found then prompts to locate the correct
path. This should result in a list of valid paths so long as the
correct path is found.

If the correct path IS found then the list is updated with the new
value. Otherwise, the routine ends after notifying the user to update
the list and try again...

Option Explicit

Sub CreatePPT()
Dim vList, n&, oPres, vPath
Dim rngSource As Range

'Edit to suit...
Const sTitle$ = "Select the correct location for this file"
Const sMsgFail$ = "Valid paths are required!" _
& vbLf & vbLf _
& "Please revise the list and try again."

Set rngSource = Selection '//edit to suit
vList = rngSource

'Ensure valid paths
For n = LBound(vList) To UBound(vList)
If Not bFileExists(vList(n, 1)) Then
'Prompt for the correct path
vPath = Application.GetSaveAsFilename(vList(n, 1), , , sTitle)
'If found, update the list
If Not vPath = False Then
vList(n, 1) = vPath: rngSource = vList
Else
MsgBox sMsgFail: Exit Sub
End If 'Not vPath = False
End If 'Not bFileExists
Next 'n

On Error GoTo Cleanup
'If we got here then we have a valid paths,
'so automate a new instance of PowerPoint
With CreateObject("PowerPoint.Application") 'appPPT
'Add a new presentation
Set oPres = .Presentations.Add
With oPres.slides
'Insert the slides into the presentation
For n = LBound(vList) To UBound(vList)
.InsertFromFile vList(n, 1), .Count
Next 'n
End With 'oPres.slides
.Visible = True
End With 'CreateObject
Cleanup:
Set oPres = Nothing: Set rngSource = Nothing
End Sub


Function bFileExists(Filename) As Boolean
' Checks if a file exists in the specified path
' Arguments: Filename (Variant) The fullname of the file
' Returns: TRUE if the file exists

On Error Resume Next
bFileExists = (Dir$(Filename) <> "")
' bFileExists = (FileLen(Filename) <> 0) '//optional method
End Function

To run your FourSQ_Dead_Hyperlinks routine on any sheet just activate
the sheet and select the range to 'flag'...

Sub FourSQ_Dead_Hyperlinks()
' Find Dead Hyperlinks
Dim c As Range

For Each c In Selection
If len(c.Value) and Not bFileExists(c.Value) Then _
c.Interior.Color = 65535
Next
MsgBox "Check Complete"
End Sub

...whch gives you the option to choose non-contiguous cells.

I can't assist you with the slide format issue. (As far as I see.., the
presentation inserts the sample slides "as is" in terms of how they
open in PPT individually!)

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

You might want to put some emphasis on this...

MsgBox sMsgFail, vbCritical: Exit Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Marty Girvan]

Thanks again Garry,

I will play with it a bit this week and post some results.

 

[Marty Girvan]

Garry,

The new code works great and I am working on the formatting issue. The only thing I would ask for help with now... is that when I ran the GARRY code with 150 cell sheet and it found an error (broken link), there is no way toknow which file it is referring to for the error. I think that if it highlighted the field and the message box came up then it would be a much easierto fix. Or any other thoughts would be great. I am trying to insert: Interior.Color = 65535 to highlight the color but I keep getting an object error. Any thoughts? Guru Garry. You have been a huge help in this projectas well as in my learning. Thanks man.

Marty

 

[GS]

Garry,

The new code works great and I am working on the formatting issue.
The only thing I would ask for help with now... is that when I ran
the GARRY code with 150 cell sheet and it found an error (broken
link), there is no way to know which file it is referring to for the
error. I think that if it highlighted the field and the message box
came up then it would be a much easier to fix. Or any other thoughts
would be great. I am trying to insert: Interior.Color = 65535 to
highlight the color but I keep getting an object error. Any
thoughts? Guru Garry. You have been a huge help in this project as
well as in my learning. Thanks man.

Marty

The filename should be displayed as the 'InitialFilename' in the browse
dialog when the listed file does not exist! What else do you need to
know?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion