excel/powerpoint

tuskastunut kopioija

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

10

353

Ää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. Vuonna 2026 jää entistä vähemmän rahaa käteen palkansaajille

      Työttömyysvakuutusmaksu nousee 0,3 prosenttia. Työeläkemaksu nousee 7,15 prosentista 7,3 prosenttiin. Työmarkkinajärjest
      Maailman menoa
      29
      5345

    2. Yritystuet pois ja työeläkevaroilla maksettava valtion velka pois

      Nyt on teille kerrottu keino kuinka Suomen velkaongelmasta päästää eroon kertalaakista. Älkää saatanat enää minulle tul
      Maailman menoa
      88
      4743

    3. Suomen kansa puhunut: Purra huonoimpia ministereitä

      Kouluarvosanalla 6–, eli samaa tasoa mitä Purran oikeakin koulutodistus. Epäpätevyys on tullut huomattua Suomen talouden
      Maailman menoa
      291
      3753

    4. Ylen juttu sisäministeristä oli selvän tarkoitushakuinen

      haluttiin vielä vuoden loppuun saada joku "kohu". (Olisiko Yle tehnyt jutun jos sisäministerinä olisi esim. RKP:n, jota
      Maailman menoa
      123
      3170

    5. Suomalaista yrittäjää ei kommunistista erota

      Muualla maailmassa yrittäjät elävät asiakkaiden rahoilla, Suomessa palkansaajien maksamilla veroilla. Palkansaajahan ma
      Maailman menoa
      47
      2709

    6. Käykö tiekarhu tasapuolisesti Hyrynsalmen teillä??

      Mitä olette mieltä?
      Hyrynsalmi
      25
      2048

    7. Joulun ruokajonoissa entistä enemmän avuntarvitsijoita - Mitä ajatuksia tämä herättää?

      Räppärit Mikael Gabriel, VilleGalle ja Jare Brand jakoivat ruokaa ja pehmeitäkin paketteja vähävaraisille jouluaattoa ed
      Maailman menoa
      107
      1897

    8. Ulkoministeriön konsulipäällikkö arvostelee rajusti Haavistoa: "Täällä on pelon ilmapiiri"

      "– Täällä on ministerin toimien takia aivan selvästi pelon ilmapiiri. Jos sellaisen annetaan pesiytyä virkamieskulttuuri
      Maailman menoa
      10
      1877

    9. Mikä on pahinta

      Mitä kaivattusi voisi tehdä sinulle?
      Ikävä
      248
      1822

    10. Pyydän anteeksi etten osannut ratkaista

      Mitään muuta kuin lähtemällä. Et oikein tullut vastaan etkä kuunnellut. Tuntui että minun piti koittaa sopia ja sovitell
      Ikävä
      74
      1739
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt