Microsoft Office Tutorials and References
In Depth Information
Copying Chart Sheets to PowerPoint Slides
5.
Saves the file.
Sub CopyChartSheets()
‘Declare Object variables for the PowerPoint application
‘and for the PowerPoint presentation file.
Dim ppApp As Object, pptPres As Object
‘Declare Object variable for a PowerPoint slide.
Dim pptSlide As Object
‘Declare variables for the Charts you will copy.
Dim ch As Chart
‘Declare an Integer type variable for a running count of slides
‘as each chart sheet is added to the new presentation file.
Dim SlideCount As Integer
‘Open PowerPoint
Set ppApp = CreateObject(“PowerPoint.Application”)
‘Make the PowerPoint application visible.
ppApp.Visible = msoTrue
‘Create a new Presentation and add a title slide.
Set pptPres = ppApp.Presentations.Add
With pptPres.Slides
Set pptSlide = .Add(.Count + 1, 11)
End With
pptSlide.Shapes.Title.TextFrame.TextRange.Text = “Chart sheet copy test”
‘Open a for Next loop to place each chart sheet in a slide.
For Each ch In ThisWorkbook.Charts
ch.CopyPicture Appearance:=xlScreen, Format:=xlPicture, Size:=xlScreen
‘Add a new slide.
SlideCount = pptPres.Slides.Count
Set pptSlide = pptPres.Slides.Add(SlideCount + 1, 11)
ppApp.ActiveWindow.View.GotoSlide pptSlide.SlideIndex
‘Paste and select the chart picture.
pptSlide.Shapes.Paste.Select
‘Align the chart to be centered in the slide.
With ppApp.ActiveWindow.Selection.ShapeRange
.Align msoAlignCenters, msoTrue
.Align msoAlignMiddles, msoTrue
End With
‘Set the position of the slide’s header label.
With ppApp.ActiveWindow.Selection
.SlideRange.Shapes.AddLabel _
(msoTextOrientationHorizontal, 300, 20, 500, 50).Select
.ShapeRange.TextFrame.WordWrap = msoFalse
‘Format the header label.
With .ShapeRange.TextFrame.TextRange
Search JabSto ::




Custom Search