Excel VBA error after 2003 to 2010 Excel upgrade

Topic

New Reply

Hi my company recently upgraded us from 2003 to 2010 Excel. Now as a result none of our macros work. Below is the Error and the entire. If someone could please explain why this is happening and what the solution is would be greatly appreciated.

VBA CODE ERROR:
With PPPres.SlideMaster.Shapes(“Rectangle 2”).TextFrame.TextRange

ENTIRE CODE:

Global oPPTApp As PowerPoint.application
Global PPPres As PowerPoint.Presentation
‘Global slidedate As Integer

Sub ToPptWithDate()
Call ToPowerPoint(1)
End Sub

Sub ToPptWithoutDate()
Call ToPowerPoint(2)
End Sub

Sub ToPowerPoint(slidedate As Integer)
Dim mess As String
Dim rngNewRange As Excel.Range

‘ Catch application window title to later activate Excel again
apptitle = application.Caption

Call CreatePPPres(slidedate)

oPPTApp.Visible = msoTrue

‘Close
‘ThisWorkbook.Sheets(“B2B_Restr”).Outline.ShowLevels ColumnLevels:=1

‘Walk through all pages
For Each sr In ThisWorkbook.Sheets
shname = sr.Name
sRange = Null
stitle = Null
ToPPT = 0
Select Case UCase(sr.Name)
Case UCase(“Menu”), “VBA”, UCase(“Data”), UCase(“DataTar”), UCase(“Dataact”)
ToPPT = 0
Case Else
sRange = “PPR”
stitle = “PPT”

‘Test if the ranges are defined
On Error Resume Next
testrange = IsEmpty(ThisWorkbook.Sheets(shname).Range(stitle))
testrange = IsEmpty(ThisWorkbook.Sheets(shname).Range(sRange))
If Err.Number = 0 Then
ToPPT = 1
Else
ToPPT = 0
mess = mess + Chr(13) + ” ” + shname + ” was skipped – missed range or title”
End If
On Error GoTo 0
End Select

If UCase(sr.Name) = “EQSUBS” Then
‘ Call createappdpage
End If

If sr.Visible = False Then
ToPPT = 0
End If

If ToPPT = 1 Then
‘ Set rngNewRange to the collection of cells in the active Excel
‘ workbook and active sheet.
ThisWorkbook.Sheets(shname).Activate
application.Goto Reference:=sRange
Set rngNewRange = ThisWorkbook.Sheets(shname).Range(sRange)

‘ Select the range then copy it.
rngNewRange.Select
‘rngNewRange.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
rngNewRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ThisWorkbook.Sheets(“VBA”).Select
Range(“B12″).Select

ActiveSheet.PasteSpecial Format:=”Picture (Enhanced Metafile)”, Link:=False _
, DisplayAsIcon:=False
pictname = (Selection.Name)

‘Fix size of object
y = 410 / Selection.ShapeRange.Height
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = y * Selection.ShapeRange.Height
Selection.ShapeRange.Width = y * Selection.ShapeRange.Width

If Selection.ShapeRange.Width > 690 Then
y = 690 / Selection.ShapeRange.Width
Selection.ShapeRange.Height = y * Selection.ShapeRange.Height
Selection.ShapeRange.Width = y * Selection.ShapeRange.Width
End If

ThisWorkbook.Sheets(“VBA”).Shapes(pictname).Copy

Set ppslide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutTitleOnly)

‘ Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
‘Paste the range and align
With ppslide.Shapes.Paste
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With
ppslide.Shapes(“Picture 3”).IncrementTop 32#

‘ Add title to slide
ppslide.Shapes(“Rectangle 2”).TextFrame.TextRange.Text = _
ThisWorkbook.Sheets(shname).Range(stitle).Value + _
Chr(13) + ThisWorkbook.Sheets(“Menu”).Range(“arearegion”).Value

‘delete picture in excel
Sheets(“VBA”).Shapes(pictname).Delete

End If
Next
‘oPPTApp.ActiveWindow.ViewType = ppViewSlide
‘ Clean up
‘PPPres.SlideShowSettings.Run

Set PPPres = Nothing
Set ppslide = Nothing
Set oPPApp = Nothing
‘ Select range A1 in all sheets
application.ScreenUpdating = False
For Each sr In ThisWorkbook.Sheets
Sheet = sr.Name
If sr.Visible = False Then
Else
ThisWorkbook.Sheets(Sheet).Select
application.Goto Reference:=Range(“A1”)
End If

Next sr
application.ScreenUpdating = True

‘Let user know results
‘ThisWorkbook.Sheets(“B2B_Restr”).Outline.ShowLevels ColumnLevels:=2
‘ThisWorkbook.Sheets(“Menu”).Select
AppActivate apptitle
If Len(mess) > 0 Then
MsgBox (“Ready ” & mess)
Else
MsgBox Chr(13) + ” Successfully copied to PowerPoint!” + Chr(13)
oPPTApp.ActiveWindow.View.GotoSlide Index:=1
‘application.ActivateMicrosoftApp xlMicrosoftPowerPoint
End If
End Sub

Sub CreatePPPres(slidedate As Integer)

Set oPPTApp = CreateObject(“PowerPoint.Application”)
Set PPPres = oPPTApp.Presentations.Add

oPPTApp.Visible = msoTrue

oPPTApp.ActiveWindow.ViewType = ppViewSlideMaster
‘——————–
‘Setup the master
With oPPTApp.ActivePresentation.SlideMaster.HeadersFooters
.Footer.Visible = msoTrue
.SlideNumber.Visible = msoTrue
End With

With PPPres.SlideMaster.Shapes(“Rectangle 2”).TextFrame.TextRange
.Font.Bold = msoTrue
.Font.Italic = msoTrue
.Font.Size = 24
.Font.Name = “Arial”
.ParagraphFormat.Alignment = ppAlignLeft
End With

PPPres.SlideMaster.Shapes(“Rectangle 2”).Select
With PPPres.Windows(1).Selection.ShapeRange
.Top = 0
.Left = 20

.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
.ScaleWidth 0.88, msoFalse, msoScaleFromTopLeft
End With

PPPres.SlideMaster.Shapes(“Rectangle 5”).Select
With PPPres.Windows(1).Selection.ShapeRange
.Height = 30
.Width = 600
.Left = 20.75
End With

With PPPres.Windows(1).Selection.ShapeRange.TextFrame.TextRange
.Font.Size = 8
.Font.Name = “Arial”
End With

PPPres.SlideMaster.Shapes(“Rectangle 5”).TextFrame.TextRange.Text = _
“Proprietary and Confidential – Not for Disclosure Outside Verizon Wireless”

oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft
With oPPTApp.ActiveWindow.Selection.ShapeRange
.IncrementLeft 39.25
.IncrementTop 30#
End With

PPPres.SlideMaster.Shapes(“Rectangle 6”).Select
With PPPres.Windows(1).Selection.ShapeRange.TextFrame.TextRange
.Font.Size = 8
.Font.Name = “Arial”
End With

oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
With oPPTApp.ActiveWindow.Selection.ShapeRange
.IncrementLeft 36#
.IncrementTop 30#
End With

‘Delete rectangle 3
PPPres.SlideMaster.Shapes(“Rectangle 3”).Select
oPPTApp.ActiveWindow.Selection.ShapeRange.Delete

If slidedate = 1 Then
PPPres.SlideMaster.Shapes(“Rectangle 4”).Select
With PPPres.Windows(1).Selection.ShapeRange.TextFrame.TextRange
.Font.Size = 8
.Font.Name = “Arial”
.Characters(Start:=1, Length:=21).InsertDateTime DateTimeFormat:=ppDateTimeMMddyyHmm, InsertAsField:=msoTrue
End With
oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
With oPPTApp.ActiveWindow.Selection.ShapeRange
‘.IncrementLeft 36#
.IncrementTop 30#
End With
Else
PPPres.SlideMaster.Shapes(“Rectangle 4”).Select
oPPTApp.ActiveWindow.Selection.ShapeRange.Delete
End If

‘Add lines
PPPres.SlideMaster.Shapes.AddLine(0#, 74#, 720#, 74#).Select
With oPPTApp.ActiveWindow.Selection.ShapeRange
.Line.Weight = 5.5
.Line.Visible = msoTrue
.Line.Style = msoLineSingle
.Line.ForeColor.SchemeColor = ppShadow
End With

PPPres.SlideMaster.Shapes.AddLine(0#, 80#, 720#, 80#).Select
With oPPTApp.ActiveWindow.Selection.ShapeRange
.Line.Weight = 2.5
.Line.Visible = msoTrue
.Line.Style = msoLineSingle
.Line.ForeColor.SchemeColor = ppShadow
End With

‘Copy in logo
ThisWorkbook.Sheets(“VBA”).Shapes(“Picture 1”).Copy

With PPPres.SlideMaster.Shapes.Paste
.Align msoAlignCenters, True
.Align msoAlignMiddles, True
End With

PPPres.SlideMaster.Shapes(“Picture 9”).Select
With oPPTApp.ActiveWindow.Selection.ShapeRange
.IncrementLeft 295.5
.IncrementTop -234.38
End With
oPPTApp.ActiveWindow.Selection.ShapeRange.IncrementTop 10#

‘Close master view:
oPPTApp.ActiveWindow.ViewType = ppViewSlide
‘————-
‘Add slide 1
Set ppslide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutText)

ppslide.Shapes(“Rectangle 3”).Select
oPPTApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Characters(Start:=1, Length:=1).Select
With oPPTApp.ActiveWindow.Selection.TextRange
With .Font
.Name = “Arial”
.Size = 32
.Bold = msoTrue
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
With .ParagraphFormat
.Alignment = ppAlignCenter
.LineRuleWithin = msoTrue
.SpaceWithin = 1.5
.Bullet.Visible = msoFalse
End With
.Text = “Verizon Wireless” + _
Chr$(CharCode:=13) + ThisWorkbook.Sheets(“VBA”).Range(“C9”).Value + Chr(13) + ThisWorkbook.Sheets(“Menu”).Range(“arearegion”).Value + Chr(13) + _
ThisWorkbook.Sheets(“VBA”).Range(“C10”).Value
End With

ppslide.Shapes(“Rectangle 2″).Select
oPPTApp.ActiveWindow.Selection.ShapeRange.Delete
‘———–
”Slide 2:
‘Set ppslide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutText)
‘
‘ ppslide.Shapes(“Rectangle 2”).TextFrame.TextRange.Text = _
‘ “Agenda” + Chr(13) + ThisWorkbook.Sheets(“Menu”).Range(“arearegion”).Value
‘
‘For r = 1 To Worksheets(“VBA”).Range(“Agenda”).CurrentRegion.Rows.Count
‘If r = 1 Then
‘ aaa = Worksheets(“VBA”).Range(“Agenda”).item(r).Value
‘Else
‘aaa = aaa + Chr(13) + Worksheets(“VBA”).Range(“Agenda”).item(r).Value
‘End If
‘Next r
‘
‘ppslide.Shapes(“Rectangle 3”).TextFrame.TextRange.Text = aaa
‘
‘ With ppslide.Shapes(“Rectangle 3”).TextFrame.TextRange
‘ .Font.Size = 18
‘ .Font.Italic = msoTrue
‘ .Font.Name = “Arial”
‘ End With
‘
‘ oPPTApp.ActiveWindow.View.GotoSlide Index:=2
‘ ppslide.Shapes(“Rectangle 3”).Select
‘ oPPTApp.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
‘ With oPPTApp.ActiveWindow.Selection.TextRange.ParagraphFormat
‘ .LineRuleWithin = msoTrue
‘ .SpaceWithin = 1.5
‘ .LineRuleBefore = msoTrue
‘ .SpaceBefore = 0.2
‘ .LineRuleAfter = msoFalse
‘ .SpaceAfter = 0
‘ With .Bullet
‘ .Visible = msoTrue
‘ .UseTextColor = msoTrue
‘ .Font.Name = “Wingdings”
‘ .Character = 167
‘ End With
‘ End With
‘ With oPPTApp.ActiveWindow.Selection
‘ .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText
‘ .ShapeRange.Left = 70
‘ .ShapeRange.Top = 140
‘ .TextRange.Font.Bold = msoTrue
‘ End With

‘ oPPTApp.ActiveWindow.Selection.ShapeRange.IncrementTop -48#
‘ oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 1.15, msoFalse, msoScaleFromTopLeft
oPPTApp.ActiveWindow.Selection.Unselect

‘ActiveWindow.Selection.SlideRange.Shapes(“Rectangle 3”).Select
‘ ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.Select
‘ ActiveWindow.Selection.ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText
‘ With ActiveWindow.Selection.ShapeRange
‘ .Left = 70
‘ .Top = 140
‘ End With
‘ ActiveWindow.Selection.ShapeRange.Top = 143.88
‘ ActiveWindow.Selection.TextRange.Font.Bold = msoTrue
End Sub

Sub createappdpage()

Set ppslide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutText)

With ppslide.Shapes(“Rectangle 3”).TextFrame.TextRange
With .Font
.Name = “Arial”
.Size = 32
.Bold = msoTrue
.Italic = msoTrue
.Underline = msoFalse
.Shadow = msoFalse
.Emboss = msoFalse
.BaselineOffset = 0
.AutoRotateNumbers = msoFalse
.Color.SchemeColor = ppForeground
End With
With .ParagraphFormat
.Alignment = ppAlignCenter
.LineRuleWithin = msoTrue
.SpaceWithin = 1.5
.Bullet.Visible = msoFalse
End With
.Text = Chr(13) + “Appendix”
End With

ppslide.Shapes(“Rectangle 2”).Delete

End Sub

Reply | Quote

Replies

What is the actual error message?

Reply | Quote

With PPPres.SlideMaster.Shapes(“Rectangle 2”).TextFrame.TextRange

Reply | Quote

Anybody? please. Thanks

Reply | Quote

This code is complicated because it’s automating PowerPoint from Excel. The code creates a new PowerPoint presentation, and then manipulates the contents of the new presentation.

The error message says “Item Rectangle 2 not found in the Shapes collection” – the code contains a lot of references to named PowerPoint Shapes, any of which lines of code will fail if the specifically-named shape is missing from the PowerPoint file. It’s possible that new PowerPoint 2003 presentations contain a shape item by that name by default, while new PowerPoint 2010 presentations don’t.

I haven’t worked with PowerPoint 2010 (nor 2007) much so don’t know the differences offhand, but the first thing I’d look at is to see what kind of shape objects are contained in a PowerPoint 2003 presentation by default, and compare that with a default PowerPoint 2010 presentation. The code may need to be re-tailored to match the types of shapes (and shape names) that exist in PowerPoint 2010 by default.

Gary

Reply | Quote

ok that’s a start where would I find those shapes?

Reply | Quote

ok that’s a start where would I find those shapes?

Here’s what I suggest. Create an object reference to the Shapes collection that you want to manipulate then add a Stop statement. Open the Locals window and drill down into the collection items to see what they are named.Then adapt your code to match. Of course, if you will need to work with PPTs based on different slide masters, this could be a somewhat fragile approach. Maybe you can check each of the shapes to see if they have a name that matches either Rectangle 2 of the new name you discover.

Reply | Quote

WHERE’S HANS?!?!?!!?

(He’d have this solved by now).

Reply | Quote

WHERE’S HANS?!?!?!!?

(He’d have this solved by now).

You can find him here ….. Eileen’s Lounge

Reply | Quote

WHERE’S HANS?!?!?!!?

(He’d have this solved by now).

aluislugo,

This is not a commercial service; this is a community where people volunteer their time and expertise to help each other out. Coming here and demanding fast answers doesn’t encourage anyone to want to make an effort to help, and is not in keeping with how this community works.

If you find a solution at another site, let us know.

Gary

Reply | Quote

aluislugo,

This is not a commercial service; this is a community where people volunteer their time and expertise to help each other out. Coming here and demanding fast answers doesn’t encourage anyone to want to make an effort to help, and is not in keeping with how this community works.

If you find a solution at another site, let us know.

Gary

Thanks Gary been to the sight before…I know how it works. IF you have a solution lmk.

And don’t be so uptight…you took my comment out of context.

Reply | Quote

And don’t be so uptight…you took my comment out of context.

Really? Where is the context that made that anything other than rude and belittling to those trying to assist you? I’m genuinely curious as I must have missed it too.

Reply | Quote

Really? Where is the context that made that anything other than rude and belittling to those trying to assist you? I’m genuinely curious as I must have missed it too.

My second quote was as it was you did not miss it.

Reply | Quote