Results 1 to 13 of 13
  1. #1
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    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.ShowLeve ls 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").Va lue

    '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.ShowLeve ls 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.HeadersFoot ers
    .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.T extRange
    .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.ScaleHei ght 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.T extRange
    .Font.Size = 8
    .Font.Name = "Arial"
    End With

    oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHei ght 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.T extRange
    .Font.Size = 8
    .Font.Name = "Arial"
    .Characters(Start:=1, Length:=21).InsertDateTime DateTimeFormat:=ppDateTimeMMddyyHmm, InsertAsField:=msoTrue
    End With
    oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHei ght 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.Incremen tTop 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.TextFram e.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").Va lue + 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").Va lue
    '
    'For r = 1 To Worksheets("VBA").Range("Agenda").CurrentRegion.Ro ws.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.TextFram e.TextRange.Select
    ' With oPPTApp.ActiveWindow.Selection.TextRange.Paragraph Format
    ' .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.Incremen tTop -48#
    ' oPPTApp.ActiveWindow.Selection.ShapeRange.ScaleHei ght 1.15, msoFalse, msoScaleFromTopLeft
    oPPTApp.ActiveWindow.Selection.Unselect

    'ActiveWindow.Selection.SlideRange.Shapes("Rectang le 3").Select
    ' ActiveWindow.Selection.ShapeRange.TextFrame.TextRa nge.Select
    ' ActiveWindow.Selection.ShapeRange.TextFrame.AutoSi ze = 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

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    5,892
    Thanks
    0
    Thanked 83 Times in 79 Posts
    What is the actual error message?
    Regards,
    Rory
    Microsoft MVP - Excel.

  4. #3
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    With PPPres.SlideMaster.Shapes("Rectangle 2").TextFrame.TextRange

    [attachment=91121oc1.docx]
    Attached Files Attached Files

  5. #4
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Anybody? please. Thanks

  6. #5
    Super Moderator
    Join Date
    Dec 2000
    Location
    New York, NY
    Posts
    2,970
    Thanks
    3
    Thanked 28 Times in 27 Posts
    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

  7. #6
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    ok that's a start where would I find those shapes?

  8. #7
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    WHERE'S HANS?!?!?!!?

    (He'd have this solved by now).

  9. #8
    5 Star Lounger
    Join Date
    Dec 2009
    Location
    East Coast, USA
    Posts
    993
    Thanks
    8
    Thanked 43 Times in 43 Posts
    Quote Originally Posted by aluislugo View Post
    WHERE'S HANS?!?!?!!?

    (He'd have this solved by now).
    You can find him here ..... Eileen's Lounge

  10. #9
    Super Moderator
    Join Date
    Dec 2000
    Location
    New York, NY
    Posts
    2,970
    Thanks
    3
    Thanked 28 Times in 27 Posts
    Quote Originally Posted by aluislugo View Post
    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

  11. #10
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by Gary Frieder View Post
    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.

  12. #11
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    5,892
    Thanks
    0
    Thanked 83 Times in 79 Posts
    Quote Originally Posted by aluislugo View Post
    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.
    Regards,
    Rory
    Microsoft MVP - Excel.

  13. #12
    Star Lounger
    Join Date
    Oct 2003
    Posts
    77
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by rory View Post
    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.

  14. #13
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    Quote Originally Posted by aluislugo View Post
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •