|
|
Creating a Presentation from a Microsoft Excel Workbook
This section shows how you can convert a Microsoft Excel workbook into a PowerPoint presentation. The following sample code creates a presentation that contains a title page and all the worksheets and charts in the workbook from which the code is run. The bulk of the code is found in the CreateXLPowerPointPresentation procedure. This procedure creates the PowerPoint presentation and applies a template.
Each worksheet or chart is added to a new slide in the following manner:The Copy method of the Worksheet object creates a new workbook. This new workbook contains only one worksheet. This is necessary because the AddOLEObject method works with files (workbooks in this case), not worksheets. If you used the current workbook, the same worksheet would be in every slide.The new workbook is saved as strTempWKB.xls.The workbook is embedded in a Shape object in the new slide by using the AddOLEObject method.The temporary workbook is deleted. Note The Copy method of a Worksheet object creates a new workbook when called without arguments.The CreateXLPowerPointPresentation procedure calls a function, strTemplateGet, to get the full name and path of a template. This template is then applied to the presentation. Examining the code in this function goes beyond the scope of this article, but the code is included in the sample files.
The code for this sample is found in the modPPTPresentation module in XLSamp.xls. To run it, open XLSamp.xls, then click Convert To Presentation on the Tools menu.
Note To use this code, you must reference the Microsoft PowerPoint 8.0 Object Library.Public Sub CreateXLPowerPointPresentation() Dim oPowerPoint As New PowerPoint.Application Dim pptPresentation As Presentation Dim pptSlide As Slide Dim ws As Worksheet Dim ch As Chart Dim wkb As Workbook Dim strTempWKB As String Dim strMeadowTemplate As String Dim strMessage As String On Error GoTo Err_CreateXLPowerPointPresentation Const MESSAGE_CAPTION = "Creating a PowerPoint Presentation" 'Build name of temporary Workbook. With Application strTempWKB = .Path & .PathSeparator & "TempWKB.xls" End With 'Create a new Presentation and add a title slide. Set pptPresentation = oPowerPoint.Presentations.Add With pptPresentation.Slides Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) pptSlide.Shapes.Title.TextFrame.TextRange.Text = "My Presentation" 'Place each worksheet in a slide. For Each ws In ThisWorkbook.Worksheets 'Copy sheet to temporary Workbook. Copy creates a new workbook 'and makes it the active workbook. ws.Copy Set wkb = ActiveWorkbook wkb.SaveAs strTempWKB 'The numbers used here are somewhat arbitrary. Set pptSlide = .Add(.Count + 1, ppLayoutBlank) pptSlide.Shapes.AddOLEObject Left:=120, Top:=110, _ Width:=480, Height:=320, _ FileName:=strTempWKB, _ Link:=msoFalse 'Close temporary Workbook and delete it. wkb.Close SaveChanges:=msoFalse Kill strTempWKB Next ws 'Place each chart in a slide. For Each ch In ThisWorkbook.Charts 'Copy chart to temporary Workbook. ch.Copy Set wkb = ActiveWorkbook wkb.SaveAs strTempWKB Set pptSlide = .Add(.Count + 1, ppLayoutBlank) pptSlide.Shapes.AddOLEObject Left:=120, Top:=110, _ Width:=480, Height:=320, _ FileName:=strTempWKB, _ Link:=msoFalse 'Close temporary Workbook and delete it. wkb.Close SaveChanges:=msoFalse Kill strTempWKB Next ch End With 'Apply meadow template if successfully found. strMeadowTemplate = strTemplateGet("Meadow") If Len(Dir(strMeadowTemplate)) > 0 Then pptPresentation.ApplyTemplate strMeadowTemplate End If oPowerPoint.Visible = msoTrueExit_CreateXLPowerPointPresentation: On Error Resume Next Set oPowerPoint = Nothing Set pptPresentation = Nothing Set pptSlide = Nothing Exit SubErr_CreateXLPowerPointPresentation: strMessage = "An unexpected error has occured. Error#" _ & Err & ": " & Error MsgBox strMessage, vbCritical, MESSAGE_CAPTION Resume Exit_CreateXLPowerPointPresentationEnd Sub |
|
