Hallo allemaal,
Ik heb een excel bestand van waaruit iedere maand automatisch een powerpoint presentatie aan wordt gemaakt.
Dit werkt als een trein.
Ik zou alleen ook graag de achtergrond automatisch aan willen passen. Het liefst met een kleurovergang.
Ik kan alleen nergens een stukje code vinden waar dat mee kan.
Mijn code is als volgt:
Heeft iemand enig idee of dit mogelijk is?
Alvast bedankt
Groeten Roel
Ik heb een excel bestand van waaruit iedere maand automatisch een powerpoint presentatie aan wordt gemaakt.
Dit werkt als een trein.
Ik zou alleen ook graag de achtergrond automatisch aan willen passen. Het liefst met een kleurovergang.
Ik kan alleen nergens een stukje code vinden waar dat mee kan.
Mijn code is als volgt:
Code:
Sub PowerPoint_1()
If MsgBox("Hiermee worden de sheets geexporteerd naar PowerPoint. Dit kan even duren." & vbNewLine & "Wil je doorgaan?", vbYesNo, "Doorgaan?") = vbNo Then
Exit Sub
Else
End If
'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
'Declareren van objecten
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.Slide
Dim cht As Excel.ChartObject
'objecten starten
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0
'Openen van powerpoint applicatie
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Nieuwe presentatie starten
newPowerPoint.Presentations.Add
'Powerpoint laten zien
newPowerPoint.Visible = True
For a = 1 To 100 Step 1
'On Error GoTo opnieuw
If Cells(a, 54).Value = "-" Then
'Nieuwe sheet toevoegen
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
'selecteren van de bron in excel
b = Cells(a, 53).Value
Range(b).Copy
activeSlide.Select
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
With newPowerPoint.ActiveWindow.Selection.ShapeRange
.Left = 15
.Top = 15
.LockAspectRatio = msoCTrue
.Width = 700
End With
'newPowerPoint.ActiveWindow.Selection.ShapeRange.PictureFormat.TransparentBackground = msoTrue
newPowerPoint.ActiveWindow.Selection.ShapeRange.PictureFormat.TransparencyColor = RGB(255, 255, 255)
'newPowerPoint.ActiveWindow.Selection.PictureFormat.TransparencyColor = RGB(255, 255, 255)
Application.CutCopyMode = False
'positie van de afbeelding in de sheet aanpassen
'newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
'newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 15
'newPowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoCTrue
'newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 700
'newPowerPoint.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
'newPowerPoint.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
Else
End If
Next a
newPowerPoint.ActivePresentation.Slides(1).Select
Range("a1").Select
MsgBox "volledig uitgevoerd"
End Sub
Heeft iemand enig idee of dit mogelijk is?
Alvast bedankt
Groeten Roel