Productpresentatie in Powerpoint genereren vanuit Excel?

Status
Niet open voor verdere reacties.

bezbro5

Gebruiker
Lid geworden
13 jan 2016
Berichten
21
Ik moet geregeld presentaties met productbladen maken waarbij ik productgegevens uit Excel over moet zetten naar Powerpoint.
De opzet is dat ieder produkt een eigen slide (productblad) krijgt en de plaats van de productgegevens op de slide iedere keer gelijk is. De gegevens die in Excel in een rij staan, zullen in Powerpoint onder elkaar moeten komen te staan:
- Artikelnummer
- Omschrijving
- Kenmerken
- Prijs
etc.

Het mooiste zou zijn ook afbeeldingen van de artikelen in Powerpoint vanuit een vaste schijflokatie in te voegen op een vaste plaats op de afzonderlijke slides. Dit heb ik al via VBA geregeld voor productoverzichten in Excel, maar ik kan me voorstellen dat het niet handig is deze weer vanuit Excel naar Powerpoint te exporteren (vooral omdat Excel helemaal niet gemaakt is om te werken met afbeeldingen).

Het aantal producten is niet altijd gelijk, dus het aantal slides is variabel. Het zou dan ook ideaal zijn als de marco d.m.v. een loop oor zou lopen tot aan het laatste artikel in de Excellijst.

Wie heeft er een VBA code beschikbaar die iets soortgelijks al kan? Mijn VBA kennis zit op beginnersniveau, dus alleen eenvoudige wijzigingen kan ik zelf aanbrengen.
 
Ik denk niet dat iemand een compleet werkende code voor je heeft (ik in ieder geval niet) omdat elke situatie toch weer anders is. Wat in ieder geval helpt: een voorbeeldbestandje met gegevens. Ik sta althans niet te popelen om eerst data in een Excel sheet te moeten inkloppen :).
En, als je zelf aan de slag wilt, hier wat linkjes: Voorbeeld 1; Voorbeeld 2
 
Ik heb alvast een macrootje voor je gemaakt die een aantal lege slides met verschillende layout produceert. Wellicht dat je die een keer kan draaien, en kan aangeven welke variant je wilt gebruiken?
Code:
Sub newPowerPoint()
'Add a reference to the Microsoft PowerPoint Library by:
    '1. Go to Tools in the VBA menu
    '2. Click on Reference
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
 
'First we declare the variables we will be using
Dim nwPP As PowerPoint.Application
Dim aSlide As PowerPoint.Slide
Dim i As Integer

    'Look for existing instance
    On Error Resume Next
    Set nwPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    'Let's create a new PowerPoint
    If nwPP Is Nothing Then Set nwPP = New PowerPoint.Application
    'Make a presentation in PowerPoint
    With nwPP
        If .Presentations.Count = 0 Then .Presentations.Add
        'Show the PowerPoint
        .Visible = True
'Deze zouden kunnen...
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObject
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectAndText
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectAndTwoObjects
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectOverText
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutPictureWithCaption
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutTextAndObject
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutTextAndTwoObjects
        .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutTextOverObject
    End With
    AppActivate ("Microsoft PowerPoint")
    Set aSlide = Nothing
    Set nwPP = Nothing
    
End Sub
 
Houden we die als basis. De macro werkt dus :).
 
Het zou trouwens mooier zijn als je de foto's als tekstverwijzing in je bestand gebruikt. Dus in een cel sla je dat zoiets op: "H:\My Documents\My Pictures\Test images\mooie_driewieler.jpg" etc. Nu staan de plaatjes er wel, maar je kan er niks mee.
 
Prima, heb de macro voor invoegen van de afbeelding aangepast. Link staat nu in de betreffende cel, achter de afbeelding.
Lokatie H:\My Pictures\Test images\mooie_driewieler.jpg
 
Laatst bewerkt:
Had zelf al de plaatjes opgeslagen en een mapverwijzing gemaakt. :). Ik vraag me af of het gewenste model wel bruikbaar is; sowieso is het (nog) lastig om een plaatje te koppelen aan een objectvak. Ik krijg het plaatje wel geïmporteerd in de dia, en het titelvak krijg ik ook gevuld. Maar dan: het plaatje staat dan dus in het linker object, en dan heb je nog één tekstobject over waar je er eigenlijk 2 nodig hebt: één voor de veldomschrijving en één voor de waarden zelf. Al kun je dat nog wel in één tekstvak zetten, maar dan zit je met de uitlijning te klooien. Dit heb ik nu:
Code:
Sub newPowerPoint()
'Microsoft PowerPoint Library toevoegen via:
    '1. Extra in het VBA menu, Verwijzingen
    '3. Zoek Microsoft PowerPoint X.0 Object Library op, check het vinkje, en druk op OK
'Variabelen declareren
Dim nwPP As PowerPoint.Application
Dim aSlide As PowerPoint.Slide
Dim oPic As Shape
Dim i As Integer
Dim rng As Range
Dim arr As Variant
Dim obj As Object
    
    'Tabel in een array zetten
    Set rng = ActiveSheet.Cells(1).CurrentRegion
    arr = rng
    
    'Kijken of PowerPoint al open is
    On Error Resume Next
    Set nwPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    'Zo niet: nieuwe maken!
    If nwPP Is Nothing Then Set nwPP = New PowerPoint.Application
    'En dan een nieuwe presentatie maken, of de bestaande gebruiken
    With nwPP
        If .Presentations.Count = 0 Then .Presentations.Add
        'La ma zien...
        .Visible = True

        For i = LBound(arr) + 1 To UBound(arr)
            .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectAndText
            '.ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutTextAndObject
            Set aSlide = .ActivePresentation.Slides(.ActivePresentation.Slides.Count)
            aSlide.Shapes(1).TextFrame.TextRange.Text = arr(i, 3)
            Set oPic = aSlide.Shapes.AddPicture(arr(i, 1), False, True, 0, 0, -1, -1)
                'Adjust the positioning of the Chart on Powerpoint Slide
    ''            aSlide.Selection.ShapeRange.Left = 15
    ''            aSlide.Selection.ShapeRange.Top = 125
    ''            aSlide.Shapes(2).Width = 200
    ''            aSlide.Shapes(2).Left = 505
        Next i
    End With
    AppActivate ("Microsoft PowerPoint")
    Set aSlide = Nothing
    Set nwPP = Nothing
    
End Sub
Daarbij wel aangetekend dat het plaatje weg is uit Excel (doe je toch niks mee) en in de eerste kolom nu het pad staat naar de foto.
 
Dit is al top.
Maar als er 2 tekstobjecten nodig zijn kan het ook zo:

Code:
Sub newPowerPoint()
'Microsoft PowerPoint Library toevoegen via:
    '1. Extra in het VBA menu, Verwijzingen
    '3. Zoek Microsoft PowerPoint X.0 Object Library op, check het vinkje, en druk op OK
'Variabelen declareren
Dim nwPP As PowerPoint.Application
Dim aSlide As PowerPoint.Slide
Dim oPic As Shape
Dim i As Integer
Dim rng As Range
Dim arr As Variant
Dim obj As Object
    
    'Tabel in een array zetten
    Set rng = ActiveSheet.Cells(1).CurrentRegion
    arr = rng
    
    'Kijken of PowerPoint al open is
    On Error Resume Next
    Set nwPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    'Zo niet: nieuwe maken!
    If nwPP Is Nothing Then Set nwPP = New PowerPoint.Application
    'En dan een nieuwe presentatie maken, of de bestaande gebruiken
    With nwPP
        If .Presentations.Count = 0 Then .Presentations.Add
        'La ma zien...
        .Visible = True

        For i = LBound(arr) + 1 To UBound(arr)
            '.ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectAndText
            '.ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutTextAndObject
            .ActivePresentation.Slides.Add .ActivePresentation.Slides.Count + 1, ppLayoutObjectAndTwoObjects
            Set aSlide = .ActivePresentation.Slides(.ActivePresentation.Slides.Count)
            aSlide.Shapes(1).TextFrame.TextRange.Text = arr(i, 3)
            Set oPic = aSlide.Shapes.AddPicture(arr(i, 1), False, True, 0, 0, -1, -1)
                'Adjust the positioning of the Chart on Powerpoint Slide
    ''            aSlide.Selection.ShapeRange.Left = 15
    ''            aSlide.Selection.ShapeRange.Top = 125
    ''            aSlide.Shapes(2).Width = 200
    ''            aSlide.Shapes(2).Left = 505
        Next i
    End With
    AppActivate ("Microsoft PowerPoint")
    Set aSlide = Nothing
    Set nwPP = Nothing
    
End Sub
 
Kan je hier ook nog de mogelijkheid invoegen dat er meerdere slides worden gegenereerd, dus per rij een slide en dat in een loop tot aan de laatste rij?
Daarnaast heb ik nog niet de tekst in het tekstvak...
 
Dat doet de macro al. Bij mij tenminste :).
 
hmmm, bij mij dus niet. krijg een foutmelding:
Foutmelding.jpg

Resultaat is als volgt:
Fantastisch product.jpg
 
Sorry, code stond verkeerd. Nu goed gedraaid en krijg de volgende foutmelding:

Aanduiding onder de cursor is niet bekend.

Foutmelding.jpg
 
Kan kloppen, die kreeg ik ook. Maar als je in je PowerPoint gaat kijken, staat het plaatje er wel. Beetje vreemd dus. Sowieso krijg ik wél de tekst in de tekstvakken, maar niet het plaatje aan het objectvak. Dus daar puzzel ik nog een beetje op. Da's ook de reden dat ik niet zo'n aandacht had voor de foutmelding :).
 
In eerste instantie vond ik de foutmelding ook niet zo schokkend, vooral omdat ik dacht dat de macro nog niet compleet was. Resultaat is ook maar 1 slide, hij stopt denk ik voor de loop?
Dank je wel voor alle moeite die je erin stopt!
 
Een foutmelding onderbreekt de uitvoering van een macro, dat klopt. Je kunt hem overigens wel werkend krijgen als je de declaratie van oPic omzet van Shape naar Object (geloof ik). Maar nogmaals: het probleem ligt elders :).
 
Zonder foutmelding:

Code:
Sub M_snb()
    sn = Sheet1.Cells(1).CurrentRegion
    
    With GetObject(, "PowerPoint.Application")
        With .Presentations.Add
            For j = 1 To UBound(sn)
                With .Slides.Add(j, 12)
                    .Shapes.AddPicture sn(j, 1), True, False, 20, 20, 400, 400
                    .Shapes.AddTextbox(1, 5, 450, 400, 50).TextEffect.Text = sn(j, 3)
                End With
            Next
        End With

        .Visible = True
    End With
End Sub
 
Laatst bewerkt:
Kan je aangeven waar ik deze moet invoegen? Volgens mij is sn ook nog niet gedeclareerd, of hoeft dat in dit geval niet?
 
Gewoon option explicit weghalen.
Declareren is overbodig.

Als ik moet aangeven waar je deze macro moet invoegen kun je beter eerst eens een basisboek over VBA bestuderen.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan