excel/powerpoint

Osaisko joku neuvoa miten saisi makrolla kopioitua excelista kaaviot(50 kpl) kuvina poverpointiin, jokainen omalle dialleen?
10375
Äänestä

Muut lukivat myös

Vastaukset 10

Vanhimmat

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.

Äänestä
  • 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

    Äänestä

  • 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).SlideIndex

    http://www.computing.net/answers/office/error-using-macro-to-copy-from-excel-to-ppt/9433.html

    Äänestä


  • 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 helposti

    Samassa taulukossa, nimetty esim "kaavio 3, kaavio 4"

    Äänestä

  • 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...

    Äänestä

  • 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

    Äänestä

  • 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 Function

    Suunnattomat kiitokset, noinhan tuo menee, ja hermotkin säästyy....

    Äänestä

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!

Äänestä
  • 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ä)

    Äänestä

Kommentoi aloitusta


tuskastunut kopioija kirjoitti:

Osaisko joku neuvoa miten saisi makrolla kopioitua excelista kaaviot(50 kpl) kuvina poverpointiin, jokainen omalle dialleen?

Anonyymi
5000

Ilmoita asiaton sisältö

  • Sisältää materiaalia, joka on loukkaavaa, herjaavaa, rasistista, uhkailevaa tai ahdistelevaa.

  • Materiaali sisältää nimiä, yhteystietoja tai muita henkilökohtaisia tietoja. Julkisuuden henkilöistä, julkisissa viroissa toimivista ihmisistä sekä yritysten vastuuhenkilöistä saa keskustella työhön liittyen. Myös yksityiselämään liittyvistä asioista voi keskustella siltä osin, kuin niistä on julkisesti kerrottu.

  • Sisältää lapsille haitallista tai heiltä kiellettyä materiaalia. Seksuaalinen sisältö on sallittua aiheeseen tarkoitetuilla palstoilla, joiden ikäraja on 18 vuotta.

  • Lainvastaista sisältöä voi olla mm. yksityiselämää loukkaavan tiedon levitys, kiihottaminen kansanryhmää vastaan, laiton uhkaaminen, alaikäisiin liittyvä seksuaalinen sisältö/grooming, petokset, identiteettivarkaudet, kunnianloukkaukset ja tekijänoikeusrikkomukset.

  • Sisältö ei liity palstan tai keskusteluketjun aiheeseen.

  • Viesti ei ole suomea tai ruotsia (pl. International Forums), se sisältää mainontaa, se sisältää tekijänoikeuksin suojattua materiaalia, se on massapostitus tai jokin muu syy.

Jaa keskustelu