- Joined
- Sep 27, 2010
- Messages
- 1
- Reaction score
- 0
I'm trying to use a Public Function to go from Excel to PPT and create a Stacked Bar Chart. Below is the code that I have, what I'm trying to do is now format the chart to remove Legends, change fonts and Recolor Series. I can't for the life of me figure out where the codes for legends such as HasLegend would go, everytime I try to enter it the VBA crashes. I'm not very familiar with advanced VBA so that is part of the issue.
Any Help on getting these additional chart customization features included would be extremely helpful. Thanks!
Public Function copy_RCM(sheet, chart_name, slide, awidth, aheight, atop, aleft)
Sheets("Charts").Select
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPSlide.Select
PPSlide.Shapes.AddChart.Chart.ChartType = xlColumnStacked
PPSlide.Select
PPSlide.Shapes(PPSlide.Shapes.Count).Select
Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange
' Resize:
sr.Width = (4.32 * 72)
sr.Height = (1.92 * 72)
If sr.Width > 700 Then
sr.Width = 700
End If
If sr.Height > 420 Then
sr.Height = 420
End If
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = (0.94 * 72)
If aleft <> 0 Then
sr.Left = (0.6 * 72)
End If
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Function
Any Help on getting these additional chart customization features included would be extremely helpful. Thanks!
Public Function copy_RCM(sheet, chart_name, slide, awidth, aheight, atop, aleft)
Sheets("Charts").Select
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPSlide.Select
PPSlide.Shapes.AddChart.Chart.ChartType = xlColumnStacked
PPSlide.Select
PPSlide.Shapes(PPSlide.Shapes.Count).Select
Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange
' Resize:
sr.Width = (4.32 * 72)
sr.Height = (1.92 * 72)
If sr.Width > 700 Then
sr.Width = 700
End If
If sr.Height > 420 Then
sr.Height = 420
End If
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = (0.94 * 72)
If aleft <> 0 Then
sr.Left = (0.6 * 72)
End If
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Function