excel/powerpoint

tuskastunut kopioija

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

10

375

Äänestä

    Vastaukset 10

    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. Olen nainen pahoillani, että tykkään sinusta niin paljon, että

      Haluaisin panna sua. Tuntuu vaan siltä, että olet sen suhteen ihan haluton. Ei minulle riitä pelkkä ystävyyssuhde.
      Ikävä
      88
      1283

    2. Puukotus Kajaanissa

      Kuka puukotti ja ketä? https://yle.fi/a/74-20247765 Vähemmän yllättäen päihteet mainittu
      Kajaani
      28
      816

    3. Liikenneonnettumuus

      Linkkari ja ruotsibiili törmäsivät linkku oli redun opetusajossa
      Ylitornio
      13
      787

    4. Mieti oikeasti

      Ollaan lähes tuntemattomia, mutta samalla on tämä erityinen vuosien tilanne takana, joka on ollut monella tapaa väärin.
      Ikävä
      38
      766

    5. Taasko sä vedit

      Suojamoodin päälle? Miehelle
      Ikävä
      90
      705

    6. Tiedoksi yhdelle naiselle

      että mies lähestyy kaikin tavoin jos on kiinnostunut! 🙋🏻‍♂️
      Ikävä
      46
      688

    7. kene ajoi "kolarin"?

      "Punkaharjulla Luston ja Tuppuranmäen välillä sattui tiistaina aamupäivällä liikenneonnettomuus. Poliisin mukaan Savonl
      Savonlinna
      17
      687

    8. Pahin tapa satuttaa toista

      On jättää toinen vaille mitään vastausta. Erityisen kipeää se tekee sillon jos toinen ghostaa.
      Ikävä
      79
      684

    9. Mitä söpö

      Mies mietit?
      Ikävä
      58
      628

    10. Minulla on joskus ikävä sinua ja ajattelen sinua joskus.. edelleen

      Olin joskus niin rakastunut sinuun. Olin onnellinen, että kohdattiin ja kun vain tiesin sinun olevan olemassa. Täytit aj
      Ikävä
      27
      627

    11. Tulisitko huomenna mun luo?

      🤗
      Ikävä
      65
      610

    12. Alkaa jotenkin nyt kuvio hahmottuu täällä

      Sellainen vaikutelma tästä alkaa tulla, että täällä on joku pieni porukka, joka tuntee toisensa tai ainakin pelaa samaan
      Ikävä
      85
      595

    13. Miten uskallan sua nähdä

      Kun vaikutat suuttuneelta :(
      Ikävä
      41
      581

    14. Jos kaivattusi on

      Varattu niin miksi et antaisi asian olla hänen suhteen. Miksi ylipäätään vielä jatkat?
      Ikävä
      47
      556

    15. Nainen, tässä olen kahden vaiheilla

      Toinen pitäisi valita ja kummassakin on hyvät ja huonot puolensa. Toinen olisi sellainen pysyvä mutta työläs. Toinen taa
      Ikävä
      55
      544

    16. Minä kyllä odotan nainen

      että sinun kanssa voisin jutella asioista ihan oikeasti.
      Ikävä
      43
      534

    17. Hyvä on sitten, jos et sitä s*ksiä halua kanssani.

      Rakastetaan vaan toisiamme, voin käydä muualla tyydyttämässä fyysisenpuolen tarpeet. Puhumalla tämäkin olisi selvinnyt.
      Ikävä
      129
      527

    18. Kylän tielle remonttia?

      Mitäköhän kylän tielle ruvetaan tekemään ku laitettu tuommoset töpsät muutamien suojateitten kohille?
      Hyrynsalmi
      13
      512

    19. Suloinen ja herkkä

      Toiset huomioiva, räväkkä, yllättävä. Ei sellaisesta voi olla pitämättä.
      Rakkaus ja rakastaminen
      31
      495

    20. Taas henkirikos

      Kuka lienee nyt asialla.
      Ilomantsi
      9
      485
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt