Copy Data fRange rom Excel and Paste to PowerPoint Table
Hello All,
I have been trying to achieve the subject task using VBA.
The idea is to copy the actual data from Excel and 'populate' the cells of an existing PP table (in other words not a picture copy and paste).
I have built the attached VBA module which copy each cell from the Excel range to the table cell.
It works but it is much too slow and I would like to modify the code to actually copy and paste the entire range in a single shot (like you can do manually).
I have been failing to make this work.
Any help appreciated.
Jean-Pierre
[vba]
Sub RangeTransferToTable()
'
' Copy each data cell in Excel range to the PowerPoint Slide 2 Shape 4 Table
'
Dim oPPP As PowerPoint.Application
Dim oPPTShape As PowerPoint.Shape
Dim rng As Excel.Range
Dim frmt As Variant
'
' Set oPPP to PowerPoint by creating a new instance of PowerPoint.
' If PowerPoint is already open, you would instead use the GetObject
' method instead.
'
Set oPPP = CreateObject("PowerPoint.Application")
'
' Set PowerPoint to be Visible.
'
oPPP.Visible = msoTrue
oPPP.ActivePresentation.Slides("Slide2").Select
oPPP.Activate
Worksheets("Essai").Activate
Set rng = ActiveSheet.Range("E6:I11")
For rw = 1 To rng.Rows.Count
For cl = 1 To rng.Columns.Count
data = rng.Cells(rw, cl).Value
If Not (IsEmpty(rng.Cells(rw, cl))) Then
If IsNumeric(rng.Cells(rw, cl)) Then 'Convert numeric value to text using number format
frmt = rng.Cells(rw, cl).NumberFormat
data = WorksheetFunction.Text(rng.Cells(rw, cl).Value, frmt)
End If
Else
data = rng.Cells(rw, cl).Value
End If
With oPPP.ActivePresentation.Slides("Slide2").Shapes(4).Table.Cell(rw, cl)
.Shape.TextFrame.TextRange.Delete
.Shape.TextFrame.TextRange.Text = data
End With
Next cl
Next rw
End Sub
[/vba]
Edited by geekgirlau 22-May-06. Reason: Insert vba tags
