Copy and paste rows from Excel to Powerpoint - vba

Question

Ok, here is what I am looking for (Im new, so be gentle):
Copy and paste (default format) from excel to powerpoint (from just the one sheet)
I can only fit so many rows in ppt - so after a slide fills, I want ppt to create a new slide
Same title for each slide is fine!
I only need columns B:K copied over
That's it, however I am stuck :( I know the below code is NOT the best way to write this and it contains errors in which I am sure will be easy to spot. I cannot find how to do this anywhere on the net.
This is what I have so far:
Sub ExcelRangeToPowerPoint()
Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
Dim i As Integer
'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")
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, ppLayoutTitleOnly)
For i = 1 To 6
'need to set focus to slde 1
PowerPointApp.ActiveWindow.View.GotoSlide (1)
'Deletes Title
'mySlide.Shapes.Title.Delete
'builds new title
mySlide.Shapes.AddShape Type:=msoShapeRectangle, left:=9, Top:=6, Width:=702, Height:=30
mySlide.Shapes(mySlide.Shapes.Count).Line.Visible = msoTrue
mySlide.Shapes(mySlide.Shapes.Count).TextFrame.TextRange.Font.Size = 20
mySlide.Shapes(mySlide.Shapes.Count).TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
mySlide.Shapes(mySlide.Shapes.Count).TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
mySlide.Shapes(mySlide.Shapes.Count).TextFrame.TextRange.Text = "Current Full Initiative Details – Branded Book as of " & Date
mySlide.Shapes(mySlide.Shapes.Count).Name = "I am TITLE"
mySlide.Shapes(mySlide.Shapes.Count).Line.ForeColor.RGB = RGB(0, 0, 0)
mySlide.Shapes(mySlide.Shapes.Count).Line.Weight = 1
mySlide.Shapes(mySlide.Shapes.Count).Fill.Visible = msoTrue
mySlide.Shapes(mySlide.Shapes.Count).Fill.ForeColor.RGB = RGB(255, 255, 255)
'Copy Range from Excel
Set rng = ActiveWorkbook.Worksheets("RAW").Range("B1:K23")
'Copy Excel Range
rng.Copy
'Paste to PowerPoint and position
PowerPointApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShapeRange.left = 10
myShapeRange.Top = 42
myShapeRange.Height = 492
myShapeRange.Width = 702
ActiveWorkbook.Sheets("RAW").Rows("2:23").Delete
Call myPresentation.Slides.Add(1, PpSlideLayout.ppLayoutTitleOnly)
'Clear The Clipboard
Application.CutCopyMode = False
Next i
End Sub

Answer 1

As requested in comments, here is the code I use to copy a slide from a master PPT template to the report PPT.
There is some extraneous code in there to provide status updates on the form we use to drive the process, as well as a debugging flag that I can toggle on/off at run time - these can both be removed.
This will serve as a starting point to finding the proper solution for your situation, and is not a complete answer to the question as asked.
'I've chosen to declare these globally, though it's probably not the best way:
Dim PPTObj As PowerPoint.Application
Dim PPTMaster As PowerPoint.Presentation
Dim PPTClinic As PowerPoint.Presentation
Private Sub InsertPPT(ByVal SlideName As String, ByVal StatusText As String)
Dim Shp As PowerPoint.Shape
Dim Top As Single
Dim Left As Single
Dim Height As Single
Dim width As Single
PPTMaster.Slides(SlideName).Copy
PPTClinic.Slides.Paste
Form_Master.ProcessStatus.Value = StatusText & " InsertPPT"
With PPTClinic.Slides(PPTClinic.Slides.count)
If Debugging Then
.Select
End If
.Design = PPTMaster.Slides(SlideName).Design 'this ensures we get all the right formatting - only seems to be necessary 1 time, but we'll just do it on all
.ColorScheme = PPTMaster.Slides(SlideName).ColorScheme
.FollowMasterBackground = PPTMaster.Slides(SlideName).FollowMasterBackground
For Each Shp In .Shapes 'loop through all the shapes on the slide
If Debugging Then
' .Select
Shp.Select
End If
Form_Master.ProcessStatus.Value = StatusText & " InsertPPT-" & Shp.Name
If Shp.Type = msoLinkedOLEObject Then 'when we find a linked one
ReLinkShape Shp, TempVars!NewXLName
'need to store off top, left, width, height
Top = Shp.Top
Left = Shp.Left
Height = Shp.Height
width = Shp.width
Shp.LinkFormat.Update 'and force the link to refresh
MySleep 2, "S" 'hopefully, the 2 second pause will allow everything to update properly before moving on.
'then reset them here - they seem to change shape when I update them
Shp.LockAspectRatio = msoFalse
Shp.Top = Top
Shp.Left = Left
Shp.width = width
Shp.Height = Height
ElseIf Shp.Name = "SlideName" And Not Debugging Then 'if it's the "SlideName" tag
Shp.Delete 'delete it (unless we're debugging)
End If
Next
End With
Form_Master.ProcessStatus.Value = StatusText
End Sub
Private Sub ReLinkShape(ByRef Shp As PowerPoint.Shape, ByVal NewDestination As String)
Dim Link() As String
Dim link2() As String
If Shp.Type = msoLinkedOLEObject Then 'when we find a linked one
Link = Split(Shp.LinkFormat.SourceFullName, "!") 'update the link to point to the new clinic spreadsheet instead of the master
If InStr(1, Link(2), "]") > 0 Then
link2 = Split(Link(2), "]")
Link(2) = "[" & TempVars!ClinicName & ".xlsx]" & link2(1)
End If
Shp.LinkFormat.SourceFullName = NewDestination & "!" & Link(1) & "!" & Link(2)
End If
End Sub
Public Sub MySleep(ByRef Unit As Double, ByRef UOM As String)
Dim Pause As Date
Pause = DateAdd(UOM, Unit, Now())
While Now < Pause
DoEvents
Wend
End Sub