|
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 = msoTrue
Exit_CreateXLPowerPointPresentation:
On Error Resume Next
Set oPowerPoint = Nothing
Set pptPresentation = Nothing
Set pptSlide = Nothing
Exit Sub
Err_CreateXLPowerPointPresentation:
strMessage = "An unexpected error has occured. Error#" _
& Err & ": " & Error
MsgBox strMessage, vbCritical, MESSAGE_CAPTION
Resume Exit_CreateXLPowerPointPresentation
End Sub | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-3-2 09:47