Excelistä powerpointtiin makro

Lisätään PowerPointissa olemassa olevaan diaan. Ja excelissä kaaviot ovat omana taulukkona, linkkejä ei tarvita, eli tämähän voisi mennä kuvana? Yksinkertaisuudessaan siis excelistä sheetiltä 1, chart 1, powerpointtiin slidelle 26 ja chartin viereen tekstiä pari ranskalaista viivaa excelin soluista A1 ja A2. Ilmeisesti myös referenssit täytyy avata Vba:sta?

Kalevi5 kirjoitti:

Lisätään PowerPointissa olemassa olevaan diaan. Ja excelissä kaaviot ovat omana taulukkona, linkkejä ei tarvita, eli tämähän voisi mennä kuvana? Yksinkertaisuudessaan siis excelistä sheetiltä 1, chart 1, powerpointtiin slidelle 26 ja chartin viereen tekstiä pari ranskalaista viivaa excelin soluista A1 ja A2. Ilmeisesti myös referenssit täytyy avata Vba:sta?

Lue lisää

tossa tommonen perusjutska...
helppo sitä fiksata

Sub ChartToPresentation()
' muista referenssi Powerpointiin...
'tarkista nimet
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PPShape As PowerPoint.Shape
Dim Teksti1 As String
Dim Teksti2 As String
Sheets(1).ChartObjects("Chart 1").Activate
Teksti1 = Sheets(1).Range("A1")
Teksti2 = Sheets(1).Range("A2")
Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide 26
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
PPSlide.Delete
Set PPSlide = PPPres.Slides.Add(2, ppLayoutBlank)
PPApp.ActiveWindow.View.GotoSlide 2
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
PPSlide.Shapes.Paste.Select
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

Set PPShape = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10#, 250#, 400#, 36#)
PPShape.TextFrame.TextRange.Text = "- " & Teksti1

Set PPShape = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 10#, 280#, 400#, 36#)
PPShape.TextFrame.TextRange.Text = "- " & Teksti2
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub


Keep EXCELing
@Kunde