Public Sub ImportFromExcel()
Dim i As Integer
Dim shp As Shape
Dim wb As Excel.Workbook
Dim xlApp As Excel.Application
'Create Excel application object
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If xlApp Is Nothing Then
MsgBox "Excel must be open to import.", vbExclamation
Exit Sub
End If
If TypeName(xlApp.Selection) = "Range" Then
'Apply hidden defined name to selected Excel range
xlApp.ActiveWorkbook.Names.Add name:="foo", RefersTo:=xlApp.Selection, Visible:=False
'Import selected range into Powerpoint
i = ActiveWindow.Selection.SlideRange.SlideIndex
xlApp.Selection.Copy
Set shp = ActivePresentation.Slides(i).Shapes.PasteSpecial(ppPasteOLEObject).Item(1) 'DOES NOT WORK!!!
' Set shp = ActivePresentation.Slides(i).Shapes.PasteSpecial(ppPasteMetafilePicture) 'WORKS!!!
With shp
' do some stuff here...
End With
End If
End Sub
|