Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Powerpoint can someone look at my code please

Status
Not open for further replies.

Chance1234

IS-IT--Management
Jul 25, 2001
7,871
US
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


 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top