VBA Code not selecting shapes... help needed

Question

Hi, I have a small VBA routine in PowerPoint (2003) that I am using to cycle through each shape of each slide and display a message box with it's coordinates (Top, Left, Bottom, Right, Width and Height).

The problem is only the first shape of each slide is actually selected the code displays all the shapes' coordinates but does not switch to select each shape in turn. Any ideas why not?

Here's the code...

Sub Locate_All_Shapes()

    Set ppApp = Application

    Set ppPres = ppApp.ActivePresentation

    For Each ppSld In ppPres.Slides

        ppSld.Select

        For Each ppShp In ppSld.Shapes

ppShp.Select            MsgBox ("Shape: " & ppShp.Name & Chr(10) & Chr(10) & _

                    "Top: " & ppShp.Top & Chr(10) & Chr(10) & _

                    "Left: " & ppShp.Left & Chr(10) & Chr(10) & _

                    "Bottom: " & (ppShp.Top + ppShp.Height) & Chr(10) & Chr(10) & _

                    "Right: " & (ppShp.Left + ppShp.Width) & Chr(10) & Chr(10) & _

                    "Width: " & ppShp.Width & Chr(10) & Chr(10) & _

                    "Height: " & ppShp.Height)

            ActiveWindow.Selection.Unselect

        Next ppShp

        If MsgBox("Next Slide?", vbYesNo, "Continue") = vbNo Then GoTo NormalExit

    Next ppSld

    Set ppShp = Nothing

    Set ppSld = Nothing

    Set ppPres = Nothing

    Set ppApp = Nothing

End Sub

Answer 1

I agree with John's diagnosis, but it seems a bit awkward to me to go into slide show view and then back to normal view. It will probably work, but if the screen flashes awkwardly between shapes, yo might try just adding a ppsld.Select after the ppshp.Select line, and if that doesn't work, then something like:

ppPres.Slides(1).Select

ppsld.Select

This will jump to the first slide and then back to the current slide. I think this is less likely to have the screen show you anything weird between shapes.

--David

Answer 2

Hi Paul

You are seeing a bug in 2003 i think. The shape is being selected but the screen isn't updating. You can probably force the screen to update by switching views as below.

Sub Locate_All_Shapes()

Dim ppPres As Presentation

Dim ppsld As Slide

Dim ppshp As Shape

    Set ppPres = ActivePresentation

    For Each ppsld In ppPres.Slides

        ppsld.Select

            ActiveWindow.ViewType = ppViewSlide

            ActiveWindow.ViewType = ppViewNormal

        For Each ppshp In ppsld.Shapes

            ppshp.Select

            MsgBox ("Shape: " & ppshp.Name & Chr(10) & Chr(10) & _

                    "Top: " & ppshp.Top & Chr(10) & Chr(10) & _

                    "Left: " & ppshp.Left & Chr(10) & Chr(10) & _

                    "Bottom: " & (ppshp.Top + ppshp.Height) & Chr(10) & Chr(10) & _

                    "Right: " & (ppshp.Left + ppshp.Width) & Chr(10) & Chr(10) & _

                    "Width: " & ppshp.Width & Chr(10) & Chr(10) & _

                    "Height: " & ppshp.Height)

            ActiveWindow.Selection.Unselect

        Next ppshp

        If MsgBox("Next Slide?", vbYesNo, "Continue") = vbNo Then GoTo NormalExit

    Next ppsld

NormalExit:

    Set ppshp = Nothing

    Set ppsld = Nothing

    Set ppPres = Nothing

End Sub

Answer 3

David thanks that works too...

John I'm going to use this method just feel it's a little neater!

Thanks both.

Answer 4

John thanks that works...

Answer 5

Hi David

I wasn't suggesting going into slide show mode just hiding the thumbnail pane for a micro second.