A mindennapok során elég gyakran felmerül olyan igény, hogy Excelben elkészített táblázatainkat, diagramjainkat PowerPoint prezentációban mutassuk be, adjuk elő egy kis extra körítés kíséretében - és szintén nem ritkaság, hogy hetente ugyanarról a témáról, ugyanabban a struktúrában kell prezentálnunk, egyedül csak az adatok változnak. Ilyenkor jól jöhet egy olyan automatizmus, amelynek keretében az Excelből egy gombnyomásra tudunk PowerPoint diára helyezni dolgokat - a következőben egy ilyen, egyszerű kis VBA kódot fogunk megnézni.
Adott tehát a következő diagram, amelyet Excelben készítünk el minden héten a bevételek heti alakulása alapján:
Nyissuk meg ALT+F11 lenyomásával a VBA-editort, majd mielőtt elkezdenénk a kódot bevinni, végezzünk el egy beállítást. A Tools menü References menüpontjára kattintás után rendeljük hozzá projektünkhöz a Microsoft PowerPoint Object Libraryt:
Aztán már mehetünk is az editorba, hogy elkezdjük a tényleges munkát. Első lépésként mint mindig, most is deklaráljuk a változóinkat:
Sub ChartcopytoPPT()
Dim PowerPointApp As Object
Dim Presentation As Object
Dim PPTSlide As Object
Ahogy elég egyértelmű már az elnevezésből is, az első maga a PowerPoint applikáció, a második azon belül egy prezentáció, a harmadik pedig értelemszerűen egy dia - és elég egyértelmű, hogy ezekre miért is van szükségünk.
Hasonló kódok esetében ilyenkor általában mindig célszerű olyan vizsgálatot végezni, hogy fut-e már a Powerpoint vagy még nem, jelen kódban én most megengedem magamnak azt a luxust az egyszerűség jegyében, hogy ezt az ellenőrzést kihagyom. Így a változók után már indíthatunk is egy PowerPointot a PowerPointApp változó feltöltésével:
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
Ez az egyszerű kódocska nem fog túl nagy problémát okozni, de azért, hogy jól belénk ívódjon, célszerű belőni egy
Application.ScreenUpdating = False
utasítást is, ami nagyobb kódok esetén egyértelműen gyorsítja a futást, hiszen a képernyő nem frissül folyamatosan a kód futása közben.
Ha ez megvan, akkor jön a következő két változó feltöltése, elsőként a Presentation változó kezdő értékét állítjuk be egy új prezentáció létrehozásával:
Set Presentation = PowerPointApp.Presentations.Add
Majd folytatjuk azzal, hogy hozzáadunk egy diát ehhez a prezihez:
Set PPTSlide = Presentation.Slides.Add(1, 11)
Az első része ennek a feltöltésnek valószínűleg egyértelmű, az Add két paramétere közül az első pedig a slide számát jelenti, a második pedig az adott slide kinézetét, layoutját - jelen esetben ez egy szöveges headert tartalmazó dia lesz, a teljes lista megnézhető a Microsoft hivatalos oldalán.
Ezután már csak annyi van hátra, hogy megfogjuk az Excelben lévő diagramunkat és nyomunk rá egy másolást:
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Copy
Ez önmagában elég favágó kis kód, hiszen nevesítjük a pontos chartot, de értelemszerűen akinek több ilyen van, az nyugodtan bedobhat egy For ciklust, amellyel az összes chart objektumon végigmehet és mindegyiket átdobálhatja a PowerPointba.
A másolás után már csak a beillesztés van hátra:
PPTSlide.Shapes.PasteSpecial DataType:=2
Az adattípus paraméter sorszámát nem kell fejből tudnunk az összes változatra, a Microsoft hivatalos oldalán ott van az egész PasteSpecial metódus leírása pontos paraméterlistával - például jelen esetben a kettes egy default beillesztés, a kinézet és formátum megtartásával.
Ezután már csak annyi van hátra, hogy aktiváljuk és előhozzuk az eddig háttérben lévő PowerPointot, majd kipucoljuk a vágólapot:
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
Ezután már csak hozzá kell rendelnünk a makrónkat egy gombhoz és egy kattintás múlva már elő is állt a prezentációnk:
Ahogy látszik, ez egy roppantul lebutított, egyszerű kis kód simán tehetünk bele mindenféle módosításokat a chartunk elhelyezkedését, méretét illetően, de elég könnyen ráhúzhatjuk több chart másolására is. Remélhetőleg ugródeszkának a fenti megfelelő lesz.
Kódunk szövegként:
Sub ChartcopytoPPT()
Dim PowerPointApp As Object
Dim Presentation As Object
Dim PPTSlide As Object
Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
Application.ScreenUpdating = False
Set Presentation = PowerPointApp.Presentations.Add
Set PPTSlide = Presentation.Slides.Add(1, 11)
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Copy
PPTSlide.Shapes.PasteSpecial DataType:=2
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.CutCopyMode = False
End Sub
