excel/powerpoint

tuskastunut kopioija

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

10

296

Ää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. Kalle Palander kertoi fantasioivansa siitä, kuinka Kiira Korpi naisi häntä sträppärillä ahteriin

      Sai potkut Yleltä. https://yle.fi/a/74-20140000
      Maailman menoa
      374
      5378

    2. Kun katsoin häntä

      Niin ajattelin että hän on niin rakas ❤️
      Ikävä
      18
      2319

    3. Mitä sanoisit kolmella sanalla

      kaivatullesi ja tunteidesi kohteelle? 🙎💝💝
      Ikävä
      198
      2181

    4. Haluisin niin

      Selvittää sun kanssa asiat. Kumpa uskaltaisin. Haluatko sinä?
      Ikävä
      107
      1516

    5. Miksi Pekkaa ei hyväksytä maailmalla julkisiin virkoihin?

      On mennyt jo monta hommaa ohitse.
      80 plus
      84
      1470

    6. Minkälainen koti

      kaivatullasi on?
      Ikävä
      74
      1032

    7. Nyt mielipiteitä kehiin?

      Niin ,onko arvon kuhmolaiset teidän mielestänne kaupungin hommissa turhia työpaikkoja/työntekijöitä? Mielipiteitä tu
      Kuhmo
      60
      1023

    8. IS: Paljastus - Tästä syystä Marika jätti Diilin kesken -Tilittää: "Jäi vähän karvas maku, koska..."

      Diilissä lähti yllättäen yksi kisaaja. Voi harmi, leikki loppui liian varhain… Diilissä Jaajo Linnonmaa etsii vetäjää Ka
      Tv-sarjat
      2
      979

    9. Martina miehensä kanssa Malediiveilla.

      Miksi täällä puhutaan erosta? Lensivät Dubaista Malediiveilĺe.
      Kotimaiset julkkisjuorut
      127
      908

    10. Ei lumous lopu koskaan

      Kerran kun tietyt sielut yhdistyvät kunnolla, ei irti pääse koskaan. Vaikka kuinka etsit muista ihmisistä sitä jotain tu
      Ikävä
      59
      796
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt