Sub PowerPoint_ExportSlidesForMoodleBookImport() ' Routine to convert Powerpoint Presentation into different formats for processing externally ' Calls other routines to carry out the functions Dim oPresentation As Presentation Dim ExportPath As String ' drive:\path where the export starts Dim ExportFolder As String ' folder where the files all go Dim ExportFilename As String ' Name of file to be exported Dim ExportFullFilename As String ' Full export path and name of file to be exported Dim Pixwidth As Integer ' size in pixels of exported image Dim Pixheight As Integer Dim oPName As String 'name of this presentation and also name of the export folder to be added to ExportPath Dim oSlide As Slide 'current slide Dim oSlideTitle As String 'current slide title (if any) Dim numberofslides As Integer 'total number of ppt slides ' Set up presentation and select first slide Set oPresentation = ActivePresentation Set oSlide = oPresentation.Slides(1) numberofslides = oPresentation.Slides.Count ' Get Pixel width from the user Pixwidth = GetPixelWidth() ' Ask user for pixel width (or overtype "GetPixelWidth()" with an integer number to set to a fixed width If Pixwidth <= 50 Then Pixwidth = 600 'user has input a silly low number or exited from the function ' Set height proportional to slide width Pixheight = (Pixwidth * ActivePresentation.PageSetup.SlideHeight) / ActivePresentation.PageSetup.SlideWidth ExportPath = ActivePresentation.Path & "\" 'set the export path as same as active presentation oPName = ActivePresentation.Name 'and set presentation name ExportFolder = ExportPath & oPName & "_Files" ' this is the folder where all the files will go If Dir(ExportFolder, vbDirectory) = "" Then MkDir ExportFolder 'create initial folder for files to be exported into (unless it already exists) 'Loop for saving each slide and creating HTML For i = 1 To numberofslides 'loop through the slide deck, starting with 1 Set oSlide = oPresentation.Slides(i) 'set current slide ExportFilename = oPName & "_" & CStr(Pixwidth) & "x" & CStr(Pixheight) & "_" & "Slide" & CStr(i) ExportFullFilename = ExportFolder & "\" & ExportFilename Debug.Print ExportFilename; ExportFullFilename With oSlide .Export ExportFullFilename & ".png", "PNG", Pixwidth, Pixheight ' write that slide to disk as a ppt file If oSlide.Layout <> ppLayoutBlank Then If oSlide.Shapes.HasTitle Then oSlideTitle = oSlide.Shapes.Title.TextFrame.TextRange.Text ' set title of the slide Else oSlideTitle = HTMLFilename ' if no title, set title = slidename End If End If Call ExportSlideHTMLWrapper(ExportFilename, ExportFolder, oSlideTitle, Pixwidth, Pixheight) End With Next i End End Sub Function GetPixelWidth() 'Ask user for the width of the images to be saved Dim strwholeNo As String 'input string used to find out the pixel width Do strwholeNo = InputBox _ ("What pixel width should be used for slides exported as images?", "Slide Exporter", "500") If StrPtr(strwholeNo) = False Then Exit Function Loop Until IsNumeric(strwholeNo) GetPixelWidth = CInt(strwholeNo) End Function Sub ExportSlideHTMLWrapper(SlideName As String, SlidePath As String, SlideTitle As String, SlideWidth As Integer, SlideHeight As Integer) 'This Function is not yet working!!!! Dim HTMLSlideOutput As String ' Total HTML for output (once calculated from below) Dim HTMLSlideOutput1 As String 'String where we will keep the HTML head for current slide Dim HTMLSlideOutput2 As String ' Rest of HTML Dim HTMLSlideOutput3 As String ' Rest of HTML Dim HTMLSlideOutput4 As String ' Rest of HTML Dim HTMLSlideOutput5 As String ' Rest of HTML Dim Filenum As Integer ' handle for file number HTMLSlideOutput1 = "" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "" HTMLSlideOutput2 = "" & vbCrLf & "" & vbCrLf & "" & vbCrLf & "
" & vbCrLf & "
" & vbCrLf & "" & vbCrLf & "
" & vbCrLf & "" & vbCrLf & "" HTMLSlideOutput = HTMLSlideOutput1 & SlideTitle & HTMLSlideOutput2 & SlideName & HTMLSlideOutput3 & SlideHeight & HTMLSlideOutput4 & SlideWidth & HTMLSlideOutput5 Debug.Print "HTMLSlideOutput = " & HTMLSlideOutput Debug.Print "HTMLSlideOutput1 = " & HTMLSlideOutput1 Debug.Print "HTMLSlideOutput2 = " & HTMLSlideOutput2 Debug.Print "HTMLSlideOutput3 = " & HTMLSlideOutput3 Debug.Print "HTMLSlideOutput4 = " & HTMLSlideOutput4 Debug.Print "HTMLSlideOutput5 = " & HTMLSlideOutput5 Filenum = FreeFile Open SlidePath & "\" & SlideName & ".html" For Output As Filenum Print #Filenum, HTMLSlideOutput Close Filenum End Sub