Attribute VB_Name = "ModuleSMIL" Public textURL As String Public textTimeCorrection As String Public optionAudio As Boolean Public textAudio As String Public textAudioMime As String Public textHeading As String Public textSubHeading As String Public textVideo As String Public textVideoMime As String ' Macro created 2005-01-01 by Pierre A. I. Wijkman, http://dsv.su.se/~pierre/ Sub SaveAsSMIL() Attribute SaveAsSMIL.VB_Description = "2005-01-01 by Pierre A. I. Wijkman, http://dsv.su.se/~pierre/" UserFormSettings.Show Path = Application.ActivePresentation.Path NameWithExt = Application.ActivePresentation.Name place = InStr(LCase(NameWithExt), ".ppt") NameWithoutExt = Mid(NameWithExt, 1, place - 1) SmilDir = Path & "\" & NameWithoutExt & "_smil" Application.ActivePresentation.SaveAs SmilDir, ppSaveAsJPG If optionAudio Then ' Audio SMIL generation ' Make smil-file Set fs = CreateObject("Scripting.FileSystemObject") SmilFileName = "smil_audio.smil" Set A = fs.CreateTextFile(SmilDir & "\" & SmilFileName, True) A.WriteLine ("") A.WriteLine ("") A.WriteLine ("") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") For Each s In ActivePresentation.Slides n = n + 1 t = Round(s.SlideShowTransition.AdvanceTime, 0) If t = 0 Then t = 1 If n = 1 Then t = t + textTimeCorrection tt = tt + t A.WriteLine (" ") Next A.WriteLine (" ") A.WriteLine (" ") listAudioFiles = Split(textAudio, " ") listAudioMimes = Split(textAudioMime, " ") For counter = 0 To UBound(listAudioFiles) A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine ("") A.Close Else ' Video SMIL generation ' Make smil-file Set fs = CreateObject("Scripting.FileSystemObject") SmilFileName = "smil_video.smil" Set A = fs.CreateTextFile(SmilDir & "\" & SmilFileName, True) A.WriteLine ("") A.WriteLine ("") A.WriteLine ("") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") For Each s In ActivePresentation.Slides n = n + 1 t = Round(s.SlideShowTransition.AdvanceTime, 0) If t = 0 Then t = 1 If n = 1 Then t = t + textTimeCorrection tTot1 = tTot1 + t A.WriteLine (" ") Next A.WriteLine (" ") A.WriteLine (" ") listVideoFiles = Split(textVideo, " ") listVideoMimes = Split(textVideoMime, " ") For counter = 0 To UBound(listVideoFiles) A.WriteLine (" ") A.WriteLine (" ") A.WriteLine (" ") A.WriteLine ("") A.Close ' Make navigation-file Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(SmilDir & "\navigation.rt", True) A.WriteLine ("") A.WriteLine ("") tTot2 = 0 For Each s In ActivePresentation.Slides m = m + 1 Title = "not ok" t = Round(s.SlideShowTransition.AdvanceTime, 0) If t = 0 Then t = 1 If m = 1 Then t = t + textTimeCorrection If ActivePresentation.Slides(m).Shapes.HasTitle Then If ActivePresentation.Slides(m).Shapes.Title.HasTextFrame Then If ActivePresentation.Slides(m).Shapes.Title.TextFrame.HasText Then Title = "ok" A.WriteLine (" ") A.WriteLine ("") A.Close ' Make title-file Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(SmilDir & "\title.rt", True) A.WriteLine ("") A.WriteLine ("") A.WriteLine (textHeading & "
") A.WriteLine ("
") A.WriteLine ("") A.WriteLine (textSubHeading) A.WriteLine ("") A.WriteLine ("
") A.Close End If ' Make the RAM-file place = InStrRev(LCase(textURL), "/") PathInternet = Mid(textURL, 1, place) FileRAM = Mid(textURL, place + 1) Set fs = CreateObject("Scripting.FileSystemObject") Set A = fs.CreateTextFile(SmilDir & "\" & FileRAM, True) A.WriteLine (PathInternet & SmilFileName) A.Close ' Display message MsgBox ("Saving completed! Copy audio/video files to " & SmilDir & " and then FTP all files in this folder to " & PathInternet & ".") End Sub 'CommandBarComboBox 'Dim ProcID As Integer 'ProcID = Shell("C:\Documents and Settings\Pierre A. I. Wijkman\Desktop\Media\Recording\hdogg251\Harddisk.exe", AppWinStyle = vbMinimizedNoFocus)