VBA: ExcelRange to PowerPoint-Slide
16.02.2020 16:56:11
Tobias
mein Vorhaben ist wie folgt:
ich möchte die Daten des Worksheets ws_Output für jeden Monat, Jahr (Spalte 1) in diesem Worksheet in eine neue PowerPoint-Slide pasten. Die Daten zum Pasten sind von Spalte 1-6 (A-F). Das Ganze soll also in einer Schleife geschehen. Für jede Slide sollen auch die Spaltenüberschriften, d.h. Zeile 1 beibehalten werden, weshalb ich mir die Ranges über Union zusammensetze. Beim Debuggen des Selects von der Variable rngComplete passt soweit alles, jedoch wird in der ersten Slide nur die Daten vom ersten Wert in Spalte 1 gepastet, in der nächsten Slide jedoch die Daten vom ersten und zweiten Wert gepastet etc. das heißt es passt etwas nicht, obwohl ich die Ranges update. Bin über eure Hilfe dankbar. Scheinbar muss ich den Range zurücksetzen nach jedem Durchlauf.
Vielen Dank und freundliche Grüße
Hier mein bisheriger Code:
Sub ExcelRangeToPowerPoint()
Dim rngComplete As Range
Dim rangeHeader As Range
Dim rangeData As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim startrowToCopy As Long
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint. _
Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Set Variable monthYearValue as cellvalue "A2"
Modul3.monthYearValue = Modul3.ws_Output.Range("A2").Text
'Set Variable startrowtoCopy = 2 -> first row with values
startrowToCopy = 2
'Loop through Month-Year-Column (only the filtered rows)
For i = 2 To Modul3.lastrowWorksheetOutput
If Modul3.monthYearValue Modul3.ws_Output.Range("A" & i).Value Then
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
'Set ranges
Set rangeHeader = Modul3.ws_Output.Range("A1:F1")
Set rangeData = Modul3.ws_Output.Range("A" & startrowToCopy & ":F" & (i - 1))
Set rngComplete = Union(rangeHeader, rangeData)
rngComplete.Select
Selection.Copy
'Copy Excel Range
'rngComplete.Copy
'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial DataType:=2 '6 = Paste as PNG
Set myShape = mySlide.Shapes(mySlide.Shapes.count)
myPresentation.Slides(1).Shapes.Title.TextFrame.TextRange.Text = "VMI Consumption Data _
for " & Modul3.monthYearValue
With myShape
myShape.Width = 400
myShape.Height = 300
'higher Left -> more right direction moving
myShape.Left = 150
'higher Top -> more bottom direction moving
myShape.Top = 130
Modul3.monthYearValue = Modul3.ws_Output.Range("A" & i).Text
End With
startrowToCopy = i
End If
Next i
'Make PowerPoint Visible and Active and FullScreen
PowerPointApp.Visible = True
PowerPointApp.Activate
Application.DisplayFullScreen = True
'Clear The Clipboard
Application.CutCopyMode = False
End Sub