Miten tehdään seuraavanlainen makro?

Haluatko,että avataan aina uusi powerpoint esitys kun makro suoritetaan vai ,että tehdään yksi esitys. Mitenkäs tietojen kanssa pitääkö päivittyä kun tiedot muuttuu Excelissä?

Yksinkertaisin tapa tehdä esitys lienee ilman makroja on seuraava

1. Avaa Powerpoint ja pienennä se
2.Valitse esitettävä alue taulokosta ja maalaa se. Raahaa se CTRL hiiren vasen painike pohjassa palkissa olevan Powerpointin päälle ja odota ,että Powerpoint aukeaa ja vie tiedot dialle ja vapauta hiiren painike.Suurenna ja muokkaa sopivaksi.
3. Lisää uusi dia
4. Toista edellisen vaiheen ohjet kaaviolle
5. Tallenna esitys
6. Excelissä Lisää/Objekti/Luo tiedostosta avaa äsken tallentamasi Powerpoint esitys.
7. Tuplaklikkaa objektia ja Powerpoint esitys alkaa, ja kun esitys loppuu niin palataan takaisin Exceliin.

VBA-editorissa "Tools", "References...", ruksi ruutuun "Microsoft PowerPoint **.* Object Library"

Saat PP:n objektit käyttöön. Ja sitten vain PP:n objekteja opiskelemaan!

Kaavion tietoalue nimetty "Data" ja oletuksena ,että kaavio on samassa taulukossa kuin tiedot ja taulukon nimi "Taul1". Vaihda nimet sopiviksi


Sub Excel2PowerPoint()
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim SheetName As String
Dim TestRange As Range
Dim TestSheet As Worksheet
Dim TestChart As ChartObject

Dim PasteChart As Boolean
Dim PasteChartLink As Boolean
Dim ChartNumber As Long

Dim PasteRange As Boolean
Dim RangePasteType As String
Dim RangeName As String
Dim AddSlidesToEnd As Boolean
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
If ppApp.Presentations.Count = 0 Then
ppApp.Presentations.Add
End If
ppApp.Visible = True
Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Worksheets("Taul1").Range("Data").Copy
ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count 1, ppLayoutBlank
ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)

Worksheets("Taul1").Activate
ActiveSheet.ChartObjects(1).Select
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
ppApp.ActivePresentation.SlideShowSettings.Run
Set ppSlide = Nothing
Set ppApp = Nothing
Range("A1").Select
End Sub