speed up data transfer from excel to ppt

[intoit]

I've been using the macro below to transfer information from an excel
spreadsheet to a ppt slide in tabular form (Office 2003). It works fine, but
it seems slow (takes approximately 12 seconds to execute). Are there tricks
to the trade to speed this thing up, or am I being too demanding?

Thanks for any advice.

Dim ObjPPAPP As New Powerpoint.Application
Dim objPPPres As Powerpoint.Presentation
Dim objPPSlide As Powerpoint.Slide
Dim rngCopy As Range
Dim lngRow As Long
Dim lngCol As Long
Dim Response_Table As Powerpoint.Shape
Dim last_row1 As Long

Set ObjPPAPP = New Powerpoint.Application
ObjPPAPP.Visible = True
'Set objPPPres = ObjPPAPP.Presentations.Open("C:\Report_Template.ppt")
Set objPPSlide =
PPpres.Slides(ObjPPAPP.ActiveWindow.Selection.SlideRange.SlideIndex)

last_row1 = Sheets("Response_Rates").Range("D65536").End(xlUp).row

Sheets("Response_Rates").Select
Set rngCopy = Range("A1" & last_row1)

With PPpres.Slides(5).Shapes.AddTable(last_row1,
rngCopy.Columns.Count, 85, 115, 580, 5)
.Name = "response_rates_table"
For lngRow = 1 To rngCopy.Rows.Count
For lngCol = 1 To rngCopy.Columns.Count
rngCopy.Cells(lngRow, lngCol).Copy
.Table.cell(lngRow,
lngCol).Shape.TextFrame.TextRange.Characters.Paste
.Table.cell(lngRow,
lngCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(Red:=0, Green:=51,
Blue:=102)
.Table.cell(lngRow,
lngCol).Shape.TextFrame.TextRange.Font.Size = 12
.Table.cell(lngRow,
lngCol).Shape.TextFrame.TextRange.Font.Name = "Optima"
.Table.cell(1,
lngCol).Shape.TextFrame.TextRange.Font.Bold = msoTrue
.Table.cell(lngRow,
lngCol).Shape.TextFrame.HorizontalAnchor = msoAnchorCenter
.Table.cell(lngRow, 1).Shape.TextFrame.HorizontalAnchor
= msoAnchorNone
.Table.cell(1, 1).Shape.TextFrame.HorizontalAnchor =
msoAnchorCenter
.Table.Columns(1).Width = 250
.Table.Columns(2).Width = 120
.Table.Columns(3).Width = 100
.Table.Columns(4).Width = 125
.Table.cell(lngRow, lngCol).Borders(1).Visible = msoFalse
.Table.cell(lngRow, lngCol).Borders(2).Visible = msoFalse
.Table.cell(lngRow, lngCol).Borders(3).Visible = msoTrue
.Table.cell(lngRow, lngCol).Borders(3).Weight = 1
.Table.cell(lngRow, lngCol).Borders(4).Visible = msoFalse
.Table.cell(lngRow, lngCol).Borders(5).Visible = msoFalse
.Table.cell(lngRow, lngCol).Borders(6).Visible = msoFalse
.Table.cell(1, lngCol).Shape.Fill.ForeColor.RGB = RGB(0,
51, 102)
.Table.cell(1, lngCol).Shape.Fill.Visible = msoTrue
.Table.cell(1,
lngCol).Shape.TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
Next
Next
End With
Application.CutCopyMode = False

 

[Chirag]

In addition to Steve's suggestions, you can transfer the text from Excel
cells directly to PowerPoint table cell instead of going through the
clipboard.

Replace the following two lines:
rngCopy.Cells(lngRow, lngCol).Copy
.Table.cell(lngRow, lngCol).Shape.TextFrame.TextRange.Characters.Paste

with the following:
.Table.cell(lngRow, lngCol).Shape.TextFrame.TextRange.Text =
rngCopy.Cells(lngRow, lngCol)

- Chirag

PowerShow - View multiple PowerPoint slide shows simultaneously
http://officeone.mvps.org/powershow/powershow.html