Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Charts Sheets to Powerpoint
I am using some code I got from a friend and it only appears to work
for embedded chart objects? I would like it to work for Charts that are in the Chart Sheet format. Any Suggestions? Thanks! Sub Charts_To_Presentation() '''''''''''''''''''''''''''''''''''''''''''''''''' ''' ' This macro copies each chart in Excel and pastes it ' as a picture in PowerPoint '''''''''''''''''''''''''''''''''''''''''''''''''' ''' Dim oPowerPoint As New PowerPoint.Application Dim appPPT As PowerPoint.Application Dim pptPres As Presentation Dim pptSlide As Slide Dim appXL As Excel.Application Dim ws As Worksheet Dim ch As Chart Dim aChtObj As ChartObject Dim wkb As Workbook Dim SlideCount As Long Dim CurrentSheetName As String '''''''''''''''''''''''''''''''''''''''''''''''''' ' Creates a new Presentation and adds title slide '''''''''''''''''''''''''''''''''''''''''''''''''' 'Set pptPres = oPowerPoint.Presentations.Add 'With pptPres.Slides ' Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) ' pptSlide.Shapes.Title.TextFrame.TextRange.Text = "XXX Survey" 'End With '''''''''''''''''''''''''''''''''''''''''''' ' Reference existing instance of PowerPoint '''''''''''''''''''''''''''''''''''''''''''' Set appPPT = GetObject(, "Powerpoint.Application") 'Reference active presentation Set pptPres = appPPT.ActivePresentation appPPT.ActiveWindow.ViewType = ppViewSlide ''''''''''''''''''''''''''''''''''''''' 'Places each embedded chart in a slide ''''''''''''''''''''''''''''''''''''''' For Each ws In ActiveWorkbook.Worksheets CurrentSheetName = ws.Name For Each aChtObj In ws.ChartObjects '''''''''''''''''''''''' 'copies chart '''''''''''''''''''''''' aChtObj.Copy '''''''''''''''''''''''''''''''''''''' 'Adds a new slide and pastes the chart '''''''''''''''''''''''''''''''''''''' SlideCount = pptPres.Slides.Count Set pptSlide = pptPres.Slides.Add(SlideCount + 1, ppLayoutBlank) appPPT.ActiveWindow.View.GotoSlide pptSlide.SlideIndex pptSlide.Shapes.PasteSpecial(ppPasteMetafilePictur e).Select 'centers the chart appPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue appPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' ' Creates a text box and pastes the Excel sheet's name in it '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' appPPT.ActiveWindow.Selection.SlideRange.Shapes.Ad dTextbox(msoTextOrientationHorizontal, 5, 10, 625, 27).Select appPPT.ActiveWindow.Selection.TextRange.ParagraphF ormat.Alignment = ppAlignLeft appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Characters(Start:=1, Length:=0).Select With appPPT.ActiveWindow.Selection.TextRange .Text = CurrentSheetName With .Font .Name = "Arial" .Size = 28 .Bold = msoFalse End With End With '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' ' Creates a text box for the take-away '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' appPPT.ActiveWindow.Selection.SlideRange.Shapes.Ad dTextbox(msoTextOrientationHorizontal, 38, 67, 652, 27).Select appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Paragraphs(Start:=1, Length:=1).ParagraphFormat.Bullet.Visible = msoFalse appPPT.ActiveWindow.Selection.TextRange.ParagraphF ormat.Alignment = ppAlignLeft appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Characters(Start:=1, Length:=0).Select With appPPT.ActiveWindow.Selection.TextRange .Text = "XXX" With .Font .Name = "Arial" .Size = 20 .Bold = msoTrue .Color.RGB = RGB(Red:=26, Green:=117, Blue:=206) End With End With Next aChtObj Next ws End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Charts Sheets to Powerpoint
Maybe this site can give some help:
http://office.microsoft.com/en-us/po...045551033.aspx "kimbobo" wrote: I am using some code I got from a friend and it only appears to work for embedded chart objects? I would like it to work for Charts that are in the Chart Sheet format. Any Suggestions? Thanks! Sub Charts_To_Presentation() '''''''''''''''''''''''''''''''''''''''''''''''''' ''' ' This macro copies each chart in Excel and pastes it ' as a picture in PowerPoint '''''''''''''''''''''''''''''''''''''''''''''''''' ''' Dim oPowerPoint As New PowerPoint.Application Dim appPPT As PowerPoint.Application Dim pptPres As Presentation Dim pptSlide As Slide Dim appXL As Excel.Application Dim ws As Worksheet Dim ch As Chart Dim aChtObj As ChartObject Dim wkb As Workbook Dim SlideCount As Long Dim CurrentSheetName As String '''''''''''''''''''''''''''''''''''''''''''''''''' ' Creates a new Presentation and adds title slide '''''''''''''''''''''''''''''''''''''''''''''''''' 'Set pptPres = oPowerPoint.Presentations.Add 'With pptPres.Slides ' Set pptSlide = .Add(.Count + 1, ppLayoutTitleOnly) ' pptSlide.Shapes.Title.TextFrame.TextRange.Text = "XXX Survey" 'End With '''''''''''''''''''''''''''''''''''''''''''' ' Reference existing instance of PowerPoint '''''''''''''''''''''''''''''''''''''''''''' Set appPPT = GetObject(, "Powerpoint.Application") 'Reference active presentation Set pptPres = appPPT.ActivePresentation appPPT.ActiveWindow.ViewType = ppViewSlide ''''''''''''''''''''''''''''''''''''''' 'Places each embedded chart in a slide ''''''''''''''''''''''''''''''''''''''' For Each ws In ActiveWorkbook.Worksheets CurrentSheetName = ws.Name For Each aChtObj In ws.ChartObjects '''''''''''''''''''''''' 'copies chart '''''''''''''''''''''''' aChtObj.Copy '''''''''''''''''''''''''''''''''''''' 'Adds a new slide and pastes the chart '''''''''''''''''''''''''''''''''''''' SlideCount = pptPres.Slides.Count Set pptSlide = pptPres.Slides.Add(SlideCount + 1, ppLayoutBlank) appPPT.ActiveWindow.View.GotoSlide pptSlide.SlideIndex pptSlide.Shapes.PasteSpecial(ppPasteMetafilePictur e).Select 'centers the chart appPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, msoTrue appPPT.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' ' Creates a text box and pastes the Excel sheet's name in it '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' appPPT.ActiveWindow.Selection.SlideRange.Shapes.Ad dTextbox(msoTextOrientationHorizontal, 5, 10, 625, 27).Select appPPT.ActiveWindow.Selection.TextRange.ParagraphF ormat.Alignment = ppAlignLeft appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Characters(Start:=1, Length:=0).Select With appPPT.ActiveWindow.Selection.TextRange .Text = CurrentSheetName With .Font .Name = "Arial" .Size = 28 .Bold = msoFalse End With End With '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' ' Creates a text box for the take-away '''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''' appPPT.ActiveWindow.Selection.SlideRange.Shapes.Ad dTextbox(msoTextOrientationHorizontal, 38, 67, 652, 27).Select appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Paragraphs(Start:=1, Length:=1).ParagraphFormat.Bullet.Visible = msoFalse appPPT.ActiveWindow.Selection.TextRange.ParagraphF ormat.Alignment = ppAlignLeft appPPT.ActiveWindow.Selection.ShapeRange.TextFrame .TextRange.Characters(Start:=1, Length:=0).Select With appPPT.ActiveWindow.Selection.TextRange .Text = "XXX" With .Font .Name = "Arial" .Size = 20 .Bold = msoTrue .Color.RGB = RGB(Red:=26, Green:=117, Blue:=206) End With End With Next aChtObj Next ws End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
All charts in workbook to powerpoint | Excel Programming | |||
Creating Charts for Use in Powerpoint | Charts and Charting in Excel | |||
Charts in each sheet to Powerpoint | Charts and Charting in Excel | |||
Excel Charts into Powerpoint | Excel Programming | |||
vba for PowerPoint Charts | Excel Programming |