excel/powerpoint

tuskastunut kopioija

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

10

351

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • 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).SlideIndex

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

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

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

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

        Suunnattomat 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!

      • kunde

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

    Takaisin ylös

    Luetuimmat keskustelut

    1. Kannattaako suomalaisen duunarin enää äänestää vasemmistopuolueita

      sillä eivät ne tunnu kovasti ajavan suomi-duunarin etuja. Jos katsotaan Vasemmistoliittoa, niin sehän on ihan feministi
      Maailman menoa
      248
      6231

    2. Jaaha, sitä on vasemmistoryhmä käynyt häiriköimässä Purran kodin vieressä

      On näköjään iso lakana levitetty puiden väliin, jossa lukee mm. "Haista vi*** Riikka Purra". Tunkekaa leikkaukset pers..
      Maailman menoa
      155
      6028

    3. Professori: Maahanmuuttajien rikollisuutta hyssytellään - hävytöntä

      Kriminologi Jukka Savolaisen mukaan ikä ja vaikeat olosuhteet eivät riitä selitykseksi. – Tutkitun tiedon valossa sanoi
      Maailman menoa
      252
      5108

    4. Päivi Räsänen vs. Abbas Bahmanpour

      (Bahmanpour on imaami Helsingissä) Syyttäjä siis jahtaa edelleen Räsästä tämän H-puheista, joissa hän on ilmeisesti vaa
      Maailman menoa
      55
      4615

    5. Demokratian uhka: Perussuomalaiset ja polarisoiva "me ja muut" -ajattelu

      Laurence Rees varoittaa, kuinka demokratian heikkeneminen ja autoritaaristen liikkeiden nousu voidaan liittää "me ja muu
      Maailman menoa
      44
      4390

    6. Mistä kummasta voi johtua se, että vasemmistolaiset usein häpeää itseään

      voiko se johtua esim. köyhyydestä? Ja tästä on siis ihan suomalainen tutkimus olemassa. "Suomalainen tutkimus osoittaa
      Maailman menoa
      64
      4239

    7. Sanna-kulttilaiset hehkuttaa edelleen Marinia, vaikka esim. Sote oli susi jo syntyessään

      mutta kulttilaiset eivät ole järjen jättiläisiä, ja sanoihin Lasse Lehtinenkin, että Suomessa on pohjoismaiden tyhmimmät
      Maailman menoa
      69
      4185

    8. Marin teki sen mihin muut eivät pystyneet, vei susi-Soten maaliin

      ja sitten hävittyjen vaalien jälkeen lähtikin vastuuta pakoon...... "Professori: sote-uudistus on täysi susi. Sosiaali
      Maailman menoa
      37
      3714

    9. Palkansaajan oikeus nauttia työuransa hedelmistä

      Työeläkejärjestelmä on verrattavissa pyramidihuijaukseen, jossa alemmat tasot, eli nykyiset palkansaajat, toimivat maksa
      Maailman menoa
      68
      2632

    10. En koskaan tule sinulle tätä kertomaan

      Kun kirjoitin sinulle viimeisintä viestiä, huomasin kyynelten valuvan poskiani pitkin.
      Ikävä
      58
      2089
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt