Run-Time error, please help

[SudiK]

Hi,

I have used the following code which works fine in Excel 2003. We are upgrading to Excel 2010 and the code does not work anymore, we did not try on Excel 2007. I am recieving a 'Run Time Error 438 Object doesn't support this property or method'. When I click debug, the line Selection.Delete is highlighted (which is line 43). Does Excel 2010 not use this function anymore? If not, how do I replace it? Any help would be much appreciated. Thanks

My code is:

'Embed active XL wksht as Icon on active slide in an open Ppt file
Dim Ppt As Object
Dim Ppt1 As PowerPoint.Application
Dim PptSlide As PowerPoint.Slide
Dim InsSht As Worksheet, InsBook As Workbook
Sub EmbedXLIcon()
Set Ppt = Nothing
On Error Resume Next
Set Ppt = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If Ppt Is Nothing Then MsgBox "PowerPoint is not running": Exit Sub
Set Ppt1 = Ppt
If Ppt1.Presentations.Count = 0 Then MsgBox "No presentation open": Exit Sub
Set InsSht = Nothing
On Error Resume Next
Set InsSht = ActiveSheet
On Error GoTo 0
If InsSht Is Nothing Then MsgBox "No worksheet active": Exit Sub

With Frm_RngInput
.Height = 78
.RefRng.Value = ActiveCell.CurrentRegion.Address
.Show
End With

If RngToCopy Is Nothing Then Exit Sub
Col1 = RngToCopy.Columns(1).Column: Col2 = Col1 + RngToCopy.Columns.Count - 1
Row1 = RngToCopy.Rows(1).Row: Row2 = Row1 + RngToCopy.Rows.Count - 1


NmS = InsSht.Name
NmB = ActiveWorkbook.Name
NmBFull = ActiveWorkbook.FullName

InsSht.Copy
Set InsBook = ActiveWorkbook
'Set ACell = ActiveCell
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial xlPasteValues
Range("A1").Select
If ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes.SelectAll
Selection.Delete
End If
If Col1 > 1 Then Range("A1", Range("A1").Offset(0, Col1 - 2)).EntireColumn.Delete
If Col2 < 256 Then
Col2 = Col2 - Col1 + 1
Range(Cells(1, Col2 + 1), Cells(1, 256)).EntireColumn.Delete
End If
If Row1 > 1 Then Range("A1", Range("A1").Offset(Row1 - 2, 0)).EntireRow.Delete
If Row2 < 65536 Then
Row2 = Row2 - Row1 + 1
Range(Cells(Row2 + 1, 1), Cells(65536, 1)).EntireRow.Delete
End If
Application.GoTo Range("A1"), True
'ACell.Select
Application.DisplayAlerts = False
InsBook.SaveAs (Left(NmBFull, Len(NmBFull) - 4) & "Temp.xls")
Application.DisplayAlerts = True
InsName = InsBook.FullName
InsBook.Close

With Ppt1.ActivePresentation.PageSetup
Swd = .SlideWidth
SHt = .SlideHeight
End With

IconLbl = NmS '& "-" & Left(NmB, Len(NmB) - 4)
Ppt1.ActiveWindow.Selection.SlideRange.Shapes.AddOLEObject(Left:=0, Top:=0, Width:=480 * 2 / 3, Height:=320 * 2 / 3, Filename:=InsName, Link:=msoFalse, DisplayAsIcon:=msoTrue, IconLabel:="").Select ', IconFileName:="C:\WINDOWS\Installer\{00000409-78E1-11D2-B60F-006097C998E7}\xlicons.exe", IconIndex:=1, IconLabel:="").Select
With Ppt1.ActiveWindow.Selection.ShapeRange
.Top = 20: .Left = 20
'.Line.DashStyle = msoLineSolid
'.Fill.Visible = msoTrue
'.Fill.ForeColor.SchemeColor = ppShadow
'.Fill.BackColor.SchemeColor = ppBackground
'.Fill.TwoColorGradient msoGradientHorizontal, 1

'.PictureFormat.CropBottom = 25
'.PictureFormat.CropLeft = 18#
'.PictureFormat.CropRight = 18#
.PictureFormat.CropLeft = 25.5
.PictureFormat.CropBottom = 33.71
.PictureFormat.CropRight = 25.5
.PictureFormat.CropTop = 1.5
.LockAspectRatio = msoFalse
.Height = 21.75
.Width = 21.75

.Top = SHt - .Height - 2
.Left = Swd / 2 - .Width - 35

.Top = 508.5
.Left = 318.875
End With
Kill InsName
Application.ActiveWindow.WindowState = xlMaximized
End Sub
Sub EmbedXLIconOld()
Set Ppt = Nothing
On Error Resume Next
Set Ppt = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If Ppt Is Nothing Then MsgBox "PowerPoint is not running": Exit Sub
Set Ppt1 = Ppt
If Ppt1.Presentations.Count = 0 Then MsgBox "No presentation open": Exit Sub
Set InsSht = Nothing
On Error Resume Next
Set InsSht = ActiveSheet
On Error GoTo 0
If InsSht Is Nothing Then MsgBox "No worksheet active": Exit Sub

With Frm_RngInput
.Height = 82.5
.RefRng.Value = ActiveCell.CurrentRegion.Address
.Show
End With

If RngToCopy Is Nothing Then Exit Sub
Col1 = RngToCopy.Columns(1).Column: Col2 = Col1 + RngToCopy.Columns.Count - 1
Row1 = RngToCopy.Rows(1).Row: Row2 = Row1 + RngToCopy.Rows.Count - 1


NmS = InsSht.Name
NmB = ActiveWorkbook.Name
NmBFull = ActiveWorkbook.FullName

InsSht.Copy
Set InsBook = ActiveWorkbook
'Set ACell = ActiveCell
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial xlPasteValues
Range("A1").Select
If ActiveSheet.Shapes.Count > 0 Then
ActiveSheet.Shapes.SelectAll
Selection.Delete
End If
If Col1 > 1 Then Range("A1", Range("A1").Offset(0, Col1 - 2)).EntireColumn.Delete
If Col2 < 256 Then
Col2 = Col2 - Col1 + 1
Range(Cells(1, Col2 + 1), Cells(1, 256)).EntireColumn.Delete
End If
If Row1 > 1 Then Range("A1", Range("A1").Offset(Row1 - 2, 0)).EntireRow.Delete
If Row2 < 65536 Then
Row2 = Row2 - Row1 + 1
Range(Cells(Row2 + 1, 1), Cells(65536, 1)).EntireRow.Delete
End If
Application.GoTo Range("A1"), True
'ACell.Select
Application.DisplayAlerts = False
InsBook.SaveAs (Left(NmBFull, Len(NmBFull) - 4) & "Temp.xls")
Application.DisplayAlerts = True
InsName = InsBook.FullName
InsBook.Close

With Ppt1.ActivePresentation.PageSetup
Swd = .SlideWidth
SHt = .SlideHeight
End With

IconLbl = NmS '& "-" & Left(NmB, Len(NmB) - 4)
Ppt1.ActiveWindow.Selection.SlideRange.Shapes.AddOLEObject(Left:=0, Top:=0, Width:=480 * 2 / 3, Height:=320 * 2 / 3, Filename:=InsName, Link:=msoFalse, DisplayAsIcon:=msoTrue).Select ', IconFileName:="C:\WINDOWS\Installer\{00000409-78E1-11D2-B60F-006097C998E7}\xlicons.exe", IconIndex:=1, IconLabel:="").Select
With Ppt1.ActiveWindow.Selection.ShapeRange
.Top = 20: .Left = 20
'.Line.DashStyle = msoLineSolid
'.Fill.Visible = msoTrue
'.Fill.ForeColor.SchemeColor = ppShadow
'.Fill.BackColor.SchemeColor = ppBackground
'.Fill.TwoColorGradient msoGradientHorizontal, 1
.PictureFormat.CropBottom = 25
.PictureFormat.CropLeft = 18#
.PictureFormat.CropRight = 18#
.Top = SHt - .Height - 2
.Left = Swd / 2 - .Width - 35
End With
Kill InsName
Application.ActiveWindow.WindowState = xlMaximized
End Sub

 

[Asala42]

I'll take a stab, I think I've run into this error before.

In the VBA editor, go to Tools>References> and make sure the Microsoft Powerpoint Object library is checked. Excel probably isn't recognizing the powerpoint object.

 

[SudiK]

Thanks for the suggestion Asala42. However, when the Reference option is greyed out. Do you know why that is?

 

[Asala42]

Are you still in break mode? That will gray the option out.

Hit the Stop/Reset button and re-check.

 

[Norie]

Do you know exactly what Selection is?

If all you want to do is delete all the shapes on the active sheet try this.

For Each shp In ActiveSheet.Shapes
      shp.Delete
Next shp

 

[SudiK]

Thanks Norie, your code worked.

Thanks Asala42 for your help too. When I stopped the code and tried the References, I got a Password pop-up. Weird since I never set-up a password