Whitney724
11-08-2016, 11:17 AM
I have a macro that copies a range of cells from Excel and pastes it into a PowerPoint slide as a table. The macro loops through a list of regions adding a slide and pasting the table for each. I have Office 2013, but the person who I'm building this for has 2010, so I'm trying to convert the code over to late binding code. You help is greatly appreciated!!!
Sub GeneratePPTSlides(region As String)
Dim newPowerPoint As Object
Dim activeSlide As Object
Dim pptShape As Object
Dim pptTemplateShape As Object
Dim rate_sht As Object
Set rate_sht = Sheets("Commercial Template")
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
newPowerPoint.Visible = True
newPowerPoint.Activate
On Error GoTo 0
rate_sht.Range("C2").Value = region
' Create Dealer Slide
Set rate_sht = Sheets("Dealer Template")
' Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
Set activeSlide = newPowerPoint.ActivePresentation.Slides.Add(Index:=1, Layout:=11)
rate_sht.Range("B4:M26").Copy
activeSlide.Shapes.Paste
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Default Dealer Buy Fees"
' If More than 5 Actions then create second Slide
If rate_sht.Cells(1, 17) > 0 Then
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
rate_sht.Range("O4:Z26").Copy
activeSlide.Shapes.PasteSpecial
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Default Dealer Buy Fees - (Continued)"
End If
' Create Commercial Slide
Set rate_sht = Sheets("Commercial Template")
' Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
rate_sht.Range("B4:M26").Copy
activeSlide.Shapes.Paste
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Commercial Dealer Buy Fees"
' If More than 5 Actions then create second Slide
If rate_sht.Cells(1, 17) > 0 Then
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
'Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
rate_sht.Range("O4:Z26").Copy
activeSlide.Shapes.PasteSpecial
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Commercial Dealer Buy Fees - (Continued)"
End If
End Sub
Function CreatePowerPointDeck(allSlides As Boolean)
Dim rate_sht As Worksheet
Set rate_sht = Sheets("Commercial Template")
If allSlides = True Then
Dim inputRange As Range
Dim c As Range
Set inputRange = Evaluate(rate_sht.Range("C2").Validation.Formula1)
For Each c In inputRange
Call GeneratePPTSlides(c.Value)
Next c
Else
Call GeneratePPTSlides(rate_sht.Range("C2").Value)
End If
MsgBox ("Copy Completed")
End Function
Sub GeneratePPTSlides(region As String)
Dim newPowerPoint As Object
Dim activeSlide As Object
Dim pptShape As Object
Dim pptTemplateShape As Object
Dim rate_sht As Object
Set rate_sht = Sheets("Commercial Template")
'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
newPowerPoint.Visible = True
newPowerPoint.Activate
On Error GoTo 0
rate_sht.Range("C2").Value = region
' Create Dealer Slide
Set rate_sht = Sheets("Dealer Template")
' Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
Set activeSlide = newPowerPoint.ActivePresentation.Slides.Add(Index:=1, Layout:=11)
rate_sht.Range("B4:M26").Copy
activeSlide.Shapes.Paste
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Default Dealer Buy Fees"
' If More than 5 Actions then create second Slide
If rate_sht.Cells(1, 17) > 0 Then
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
rate_sht.Range("O4:Z26").Copy
activeSlide.Shapes.PasteSpecial
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Default Dealer Buy Fees - (Continued)"
End If
' Create Commercial Slide
Set rate_sht = Sheets("Commercial Template")
' Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
rate_sht.Range("B4:M26").Copy
activeSlide.Shapes.Paste
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Commercial Dealer Buy Fees"
' If More than 5 Actions then create second Slide
If rate_sht.Cells(1, 17) > 0 Then
Set activeSlide = newPowerPoint.ActivePresentation.Slides.AddSlide(newPowerPoint.ActivePresen tation.Slides.Count + 1, newPowerPoint.ActivePresentation.Slides(1).CustomLayout)
'Call ShowHideColumns(rate_sht.Name, rate_sht.Range("C2"))
rate_sht.Range("O4:Z26").Copy
activeSlide.Shapes.PasteSpecial
Set pptShape = activeSlide.Shapes(activeSlide.Shapes.Count)
pptShape.Left = 16
pptShape.Height = _
Application.InchesToPoints(5.13)
pptShape.Table.Rows(6).Height = _
Application.InchesToPoints(0.19)
pptShape.Table.Columns(1).Width = _
Application.InchesToPoints(0.41)
pptShape.Table.Columns(2).Width = _
Application.InchesToPoints(1.44)
pptShape.Table.Columns(3).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(4).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(5).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(6).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(7).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(8).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(9).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(10).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(11).Width = _
Application.InchesToPoints(0.76)
pptShape.Table.Columns(12).Width = _
Application.InchesToPoints(0.76)
Set pptShape = activeSlide.Shapes("Title 1")
pptShape.TextFrame.TextRange.Text = rate_sht.Cells(2, 3) & " Market -- Whole Car Proposed Commercial Dealer Buy Fees - (Continued)"
End If
End Sub
Function CreatePowerPointDeck(allSlides As Boolean)
Dim rate_sht As Worksheet
Set rate_sht = Sheets("Commercial Template")
If allSlides = True Then
Dim inputRange As Range
Dim c As Range
Set inputRange = Evaluate(rate_sht.Range("C2").Validation.Formula1)
For Each c In inputRange
Call GeneratePPTSlides(c.Value)
Next c
Else
Call GeneratePPTSlides(rate_sht.Range("C2").Value)
End If
MsgBox ("Copy Completed")
End Function