|
EH出版的《Excel2003 VBA实战技巧精粹》中的例子给你参考一下。
Sub PPTTest()
Dim pptApp As PowerPoint.Application
Dim pptPresen As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim strTitle As String, strTemp As String
Dim strAVG As String
On Error GoTo errHandle
Sheet2.Select
strTitle = Cells(1, 2)
strAVG = "ÆßÔÂÖÁ°ËÔÂƽ¾ùÀÛ»ýÔö³¤" & Format(Cells(11, 11), "0.00") & "%"
strTemp = "C:\Program Files\Microsoft Office\Templates\" & _
"Presentation Designs\Pixel.pot"
Range(Cells(3, 2), Cells(11, 11)).CopyPicture
Set pptApp = CreateObject("Powerpoint.Application")
Set pptPresen = pptApp.Presentations.Add(msoTrue)
pptApp.Visible = True
pptPresen.ApplyTemplate Filename:=strTemp
Set pptSlide = pptPresen.Slides.Add(1, ppLayoutTitle)
pptSlide.Shapes("Rectangle 2").TextFrame.TextRange.Text = strTitle
pptSlide.Shapes("Rectangle 3").TextFrame.TextRange.Text = Date
Set pptSlide = pptPresen.Slides.Add(2, ppLayoutBlank)
pptSlide.Shapes.Paste
With pptSlide.Shapes(1)
.Left = 54#
.Top = 66#
.ScaleWidth 1.4, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.4, msoFalse, msoScaleFromTopLeft
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
ThisWorkbook.Activate
Sheet2.Select
Sheet2.ChartObjects(1).CopyPicture
pptSlide.Shapes.Paste
With pptSlide.Shapes(2)
.Left = 54#
.Top = 252#
.ScaleWidth 1.4, msoFalse, msoScaleFromTopLeft
.ScaleHeight 1.4, msoFalse, msoScaleFromTopLeft
End With
Set pptSlide = pptPresen.Slides.Add(3, ppLayoutText)
pptSlide.Shapes("Rectangle 2").TextFrame.TextRange.Text = "×ܽá"
pptSlide.Shapes("Rectangle 3").TextFrame.TextRange.Text = strAVG
pptPresen.SaveAs Filename:="C:\test\¹ÉƱ×ܽá.ppt"
pptPresen.Close
pptApp.Quit
errExit:
Set pptSlide = Nothing
Set pptPresen = Nothing
Set pptApp = Nothing
Exit Sub
errHandle:
MsgBox Err.Description
Resume errExit
End Sub |
|