Chance1234
IS-IT--Management
i have the below code, and i need to make some improvements to it as i need to distribute it to people with different version of powerpoint.
basicly the presentation contains one slide which is just a flashy title, on the C: drive in the folder each user has a folder called c:\temp\storyboards\ in that folder is a whole serious of pictures which the first two letters of there filename refers to a scene number, the last two refer to a shot number. the code works but is messy
firstly i have to click the title slide befoer the code will run otehrwise it errors i dont know why this is. also im using the microsoft scripting libary to go through the folder. what can i do if the user doesnt has this libary and finally i have written this is powerpoint 2000 i have no way of knowing whether it will work in 97 could someone test it for me ? jsut stick any files in that folder on c: basicly what should happen is yuo get two pitcutes on each slide.
thanks
ChanceSub CrtPresentation()
Dim FsO As FileSystemObject
Dim Fld As Folder
Dim fiL As File
Dim StrFil As String
Dim StrTit As String
Dim AddorNew As Boolean
Set FsO = New FileSystemObject
Set Fld = FsO.GetFolder("C:\temp\storyboards"
AddorNew = True
For Each fiL In Fld.Files
StrFil = fiL.Path
StrTit = "SC: " & Left(fiL.Name, 2) & " " & "Shot ##" & Mid(fiL.Name, 3, 2)
If AddorNew = True Then
'----------------------insert slide
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutBlank).SlideIndex
'-----------------------Insert picture
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(StrFil, msoFalse, msoTrue, Left:=106, Top:=72, Width:=350, Height:=220).Select
'-----------------------Insert Text----------------------------
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 106#, 30, 350#, 36#).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = StrTit
With .Font
.Name = "Times New Roman"
.Size = 24
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
AddorNew = False
Else
'-----------------------Insert Picture
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(StrFil, msoFalse, msoTrue, Left:=106, Top:=400, Width:=350, Height:=220).Select
'-----------------------Insert Text----------------------------
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 106#, 370, 350#, 36#).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = StrTit
With .Font
.Name = "Times New Roman"
.Size = 24
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
AddorNew = True
End If
Next
End Sub
basicly the presentation contains one slide which is just a flashy title, on the C: drive in the folder each user has a folder called c:\temp\storyboards\ in that folder is a whole serious of pictures which the first two letters of there filename refers to a scene number, the last two refer to a shot number. the code works but is messy
firstly i have to click the title slide befoer the code will run otehrwise it errors i dont know why this is. also im using the microsoft scripting libary to go through the folder. what can i do if the user doesnt has this libary and finally i have written this is powerpoint 2000 i have no way of knowing whether it will work in 97 could someone test it for me ? jsut stick any files in that folder on c: basicly what should happen is yuo get two pitcutes on each slide.
thanks
ChanceSub CrtPresentation()
Dim FsO As FileSystemObject
Dim Fld As Folder
Dim fiL As File
Dim StrFil As String
Dim StrTit As String
Dim AddorNew As Boolean
Set FsO = New FileSystemObject
Set Fld = FsO.GetFolder("C:\temp\storyboards"
AddorNew = True
For Each fiL In Fld.Files
StrFil = fiL.Path
StrTit = "SC: " & Left(fiL.Name, 2) & " " & "Shot ##" & Mid(fiL.Name, 3, 2)
If AddorNew = True Then
'----------------------insert slide
ActiveWindow.View.GotoSlide Index:=ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutBlank).SlideIndex
'-----------------------Insert picture
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(StrFil, msoFalse, msoTrue, Left:=106, Top:=72, Width:=350, Height:=220).Select
'-----------------------Insert Text----------------------------
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 106#, 30, 350#, 36#).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = StrTit
With .Font
.Name = "Times New Roman"
.Size = 24
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
AddorNew = False
Else
'-----------------------Insert Picture
ActiveWindow.Selection.SlideRange.Shapes.AddPicture(StrFil, msoFalse, msoTrue, Left:=106, Top:=400, Width:=350, Height:=220).Select
'-----------------------Insert Text----------------------------
ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 106#, 370, 350#, 36#).Select
ActiveWindow.Selection.ShapeRange.TextFrame.WordWrap = msoTrue
ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=0).Select
With ActiveWindow.Selection.TextRange
.Text = StrTit
With .Font
.Name = "Times New Roman"
.Size = 24
.Bold = msoFalse
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
End With
AddorNew = True
End If
Next
End Sub