speed up data transfer from excel to ppt


I

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:D" & 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
 
Ad

Advertisements

C

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top