Osaisko joku neuvoa miten saisi makrolla kopioitua excelista kaaviot(50 kpl) kuvina poverpointiin, jokainen omalle dialleen?
excel/powerpoint
10
286
Vastaukset
- joskus vba
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.
- tuskastunut kopioija
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 - tuosta apuja
tuskastunut kopioija kirjoitti:
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).SlideIndexhttp://www.computing.net/answers/office/error-using-macro-to-copy-from-excel-to-ppt/9433.html
tuosta apuja kirjoitti:
http://www.computing.net/answers/office/error-using-macro-to-copy-from-excel-to-ppt/9433.html
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- tuskastunut kopioija
kunde kirjoitti:
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 helpostiSamassa taulukossa, nimetty esim "kaavio 3, kaavio 4"
- muuan mies
tuskastunut kopioija kirjoitti:
Samassa taulukossa, nimetty esim "kaavio 3, kaavio 4"
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... muuan mies kirjoitti:
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- tuskastunut kopioija
kunde kirjoitti:
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 FunctionSuunnattomat kiitokset, noinhan tuo menee, ja hermotkin säästyy....
- Apua kaivataan
Hei!
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!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ä)
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 1521878
Kun viimeksi kohtasitte/näitte
Mitä olitte tekemässä? Millainen ympäristö oli? Löydetään toisemme...1301741Olet kyllä vaarallisen himokas
Luova, kaunis, määrätietoinen, pervo, mielenkiintoinen, kovanaama, naisellinen ja erikoinen.1021497Anna vielä vähän vihreää valoa
Teen sitten siirtoni, nainen. Tiedän, että olet jo varovaisesti yrittänyt lähestyä, mutta siitä on jo aikaa. Jos tunnet171203- 681187
- 641151
- 219965
- 66787
- 45730
Miksi homous puhuttaa konservatiiveja vuodesta toiseen?
Kysymykseen on vastattukin Kansanlähetyksen osalta: "Miksi sukupuoleen ja seksuaalisuuteen liittyvät asiat ovat konserv191704