ei käsittääkseni onnistu, eli VBA:lla pitänee koodata. ellei se ole ennestään (hyvin) tuttua, veikkaan, että 50 kuvaa menee ctrl-c ctrl-v :llä paljon nopeammin.
Yritin tuota nauhoiusta kanssa, ei se tosiaan toimi. Ongelmaksi tuli kun noita 50 kpl settejä on 36 kpl, ja toistuu vielä 3 kertaa vuodessa
Pysyn luomaan excel makrolla kyllä uuden diaesityksen, mutta en liittämään siihen tuota dian kopiointia, siinä varsinainen ongelma
Tässä alkupätkää ...
Sub PowerPointtia_excelista()
Dim ppApp As PowerPoint.Application
Dim myPpt As PowerPoint.Presentation
'muodostetaan powerpoint instanssi
Set ppApp = New PowerPoint.Application
With ppApp
.Visible = True
End With
' aloitetaan uusi esitys
Set myPpt = ppApp.Presentations.Add
' luodaan esitykseen uusi sivu tyhjällä rakenteella
ppApp.ActiveWindow.View.GotoSlide Index:=ppApp.ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutBlank).SlideIndex
Missäs noi 50 kaaviota on työkirjassa?
Samassa taulukossa vaiko eri taulukossa vaiko kaaviosivuilla?
Miten nimetty?
Eiköhän se noilla tiedolla onnistu jo melko helposti
Tuolla on toinen vastaava makro: http://peltiertech.com/Excel/XL_PPT.html#chartstitlesslides
"Paste Each Embedded Chart in the Active Worksheet into a New Slide in the Active Presentation, using the Chart Title as the Slide Title" -makro lisää PP dian otsikoksi sen kaavion otsikon.
Ja nimim. "tuosta apuja" viestiin viitaten VBE:ssä pitää olla Tools References MS PP Object Library olla ruksattuna...
ihan hyvät linkit oli annettu...
Tossa nyt koodi, jossa ei tartte aukaista Powerpointia etukäteen tai jos esitys on jo auki -
lisää aktiivisen esityksen loppuun kaaviot...
moduuliin...
Dim powApp As PowerPoint.Application
Dim powPres As PowerPoint.Presentation
Dim powSlide As PowerPoint.Slide
Dim laskuri As Long
Sub KaaviotPowerpointtiin()
' Aseta viittaus Microsoft PowerPoint Object Library
If ActiveSheet.ChartObjects.Count = 0 Then
MsgBox "Aktiivinen taulukko ei sisällä kaavioita!!!", vbInformation
Exit Sub
End If
OnkoPowerpoint = TsekkaaPowerpoint() 'tsekataan onko Powerpoint käynnissä
If OnkoPowerpoint Then
Set powApp = GetObject(, "Powerpoint.Application")
Else
Set powApp = CreateObject("Powerpoint.application")
powApp.Visible = True
End If
If powApp.Presentations.Count = 0 Then
powApp.Presentations.Add
End If
For laskuri = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(laskuri).Chart
.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
End With
If powApp.ActivePresentation.Slides.Count = 0 Then
Set powSlide = powApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Else
powApp.ActivePresentation.Slides.Add powApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
End If
powApp.ActiveWindow.View.GotoSlide powApp.ActivePresentation.Slides.Count
Set powSlide = powApp.ActivePresentation.Slides(powApp.ActivePresentation.Slides.Count)
powSlide.Shapes.Paste.Select
powApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
powApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Next
Set powSlide = Nothing
Set powPres = Nothing
Set powApp = Nothing
End Sub
Function TsekkaaPowerpoint() As Boolean
On Error Resume Next
Set powApp = GetObject(, "Powerpoint.Application")
TsekkaaPowerpoint = (Error.Number = 0)
Set powApp = Nothing
Err.Clear
End Function
Olisi samaan asiaan liityvä ongelma: Pitäisi kopioida 26 kuvaajaa (kuvana) valmiiseen powerpoint raporttipohjaan omille sivuilleen ja tiettyyn kohtaan. Ongelma on, että eri exceleitä ja on kymmeniä, joten copy paste menetelmä vie kauan aikaa.
Lisäkyssäri2
Missäs noi 26 kaaviota on työkirjassa?
Samassa taulukossa vaiko eri taulukossa vaiko kaaviosivuilla?
onko ne kuvia ???
miten nimetty ja onko aina samannimisessä taulukossa?
helpointa lienee kun laitat kyssärin mallitiedostoineen http://www.kundepuu.com (vaatii rekisteröitymisen- lukea voi ilman rekisteröitymistä)
pelkällä makronauhoittimella
ei käsittääkseni onnistu, eli VBA:lla pitänee koodata. ellei se ole ennestään (hyvin) tuttua, veikkaan, että 50 kuvaa menee ctrl-c ctrl-v :llä paljon nopeammin.Pysyn luomaan excel makrolla kyllä uuden diaesityksen, mutta en liittämään siihen tuota dian kopiointia, siinä varsinainen ongelma
Tässä alkupätkää ...
Sub PowerPointtia_excelista()
Dim ppApp As PowerPoint.Application
Dim myPpt As PowerPoint.Presentation
'muodostetaan powerpoint instanssi
Set ppApp = New PowerPoint.Application
With ppApp
.Visible = True
End With
' aloitetaan uusi esitys
Set myPpt = ppApp.Presentations.Add
' luodaan esitykseen uusi sivu tyhjällä rakenteella
ppApp.ActiveWindow.View.GotoSlide Index:=ppApp.ActivePresentation.Slides.Add(Index:=1, Layout:=ppLayoutBlank).SlideIndex
no oisko
http://www.computing.net/answers/office/error-using-macro-to-copy-from-excel-to-ppt/9433.htmlLisäkyssäri
Missäs noi 50 kaaviota on työkirjassa?Samassa taulukossa vaiko eri taulukossa vaiko kaaviosivuilla?
Miten nimetty?
Eiköhän se noilla tiedolla onnistu jo melko helposti
Tuolla toinen
Tuolla on toinen vastaava makro:http://peltiertech.com/Excel/XL_PPT.html#chartstitlesslides
"Paste Each Embedded Chart in the Active Worksheet into a New Slide in the Active Presentation, using the Chart Title as the Slide Title" -makro lisää PP dian otsikoksi sen kaavion otsikon.
Ja nimim. "tuosta apuja" viestiin viitaten VBE:ssä pitää olla Tools References MS PP Object Library olla ruksattuna...
VBA
ihan hyvät linkit oli annettu...Tossa nyt koodi, jossa ei tartte aukaista Powerpointia etukäteen tai jos esitys on jo auki -
lisää aktiivisen esityksen loppuun kaaviot...
moduuliin...
Dim powApp As PowerPoint.Application
Dim powPres As PowerPoint.Presentation
Dim powSlide As PowerPoint.Slide
Dim laskuri As Long
Sub KaaviotPowerpointtiin()
' Aseta viittaus Microsoft PowerPoint Object Library
If ActiveSheet.ChartObjects.Count = 0 Then
MsgBox "Aktiivinen taulukko ei sisällä kaavioita!!!", vbInformation
Exit Sub
End If
OnkoPowerpoint = TsekkaaPowerpoint() 'tsekataan onko Powerpoint käynnissä
If OnkoPowerpoint Then
Set powApp = GetObject(, "Powerpoint.Application")
Else
Set powApp = CreateObject("Powerpoint.application")
powApp.Visible = True
End If
If powApp.Presentations.Count = 0 Then
powApp.Presentations.Add
End If
For laskuri = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(laskuri).Chart
.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
End With
If powApp.ActivePresentation.Slides.Count = 0 Then
Set powSlide = powApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
Else
powApp.ActivePresentation.Slides.Add powApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
End If
powApp.ActiveWindow.View.GotoSlide powApp.ActivePresentation.Slides.Count
Set powSlide = powApp.ActivePresentation.Slides(powApp.ActivePresentation.Slides.Count)
powSlide.Shapes.Paste.Select
powApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
powApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Next
Set powSlide = Nothing
Set powPres = Nothing
Set powApp = Nothing
End Sub
Function TsekkaaPowerpoint() As Boolean
On Error Resume Next
Set powApp = GetObject(, "Powerpoint.Application")
TsekkaaPowerpoint = (Error.Number = 0)
Set powApp = Nothing
Err.Clear
End Function
excel/powerpoint
Suunnattomat kiitokset, noinhan tuo menee, ja hermotkin säästyy....Olisi samaan asiaan liityvä ongelma: Pitäisi kopioida 26 kuvaajaa (kuvana) valmiiseen powerpoint raporttipohjaan omille sivuilleen ja tiettyyn kohtaan. Ongelma on, että eri exceleitä ja on kymmeniä, joten copy paste menetelmä vie kauan aikaa.
Kiitos!
Missäs noi 26 kaaviota on työkirjassa?
Samassa taulukossa vaiko eri taulukossa vaiko kaaviosivuilla?
onko ne kuvia ???
miten nimetty ja onko aina samannimisessä taulukossa?
helpointa lienee kun laitat kyssärin mallitiedostoineen http://www.kundepuu.com (vaatii rekisteröitymisen- lukea voi ilman rekisteröitymistä)