Loop Through Worksheet Shapes, Display Properties and Delete
This example show the syntax to loop through all the pictures in a worksheet, print some of their properties, and delete them. The next example shows how to loop through all shape objects, determine their type, and display their characteristics. The OLEEmbedded type 12 objects are then identified and properties are displayed (i.e. radio buttons and command buttons).
Program Code
Option Explicit
Public Sub LoopThroughPictures()
Dim Shape As Shape
For Each Shape In ActiveSheet.Shapes
If Left(Shape.Name, 7) = "Picture" Then
Shape.Select
Debug.Print Shape.Name
Debug.Print Shape.Left
Debug.Print Shape.Top
Debug.Print Shape.BottomRightCell.Address
Debug.Print Shape.TopLeftCell.Address
Shape.Delete
End If
Next
End Sub
Public Sub LoopThroughObjectsExample()
Dim Shape As Shape
Dim i As Long
' *******************************************************
' This Loops Through All Shapes
' *******************************************************
For Each Shape In Sheets("Original").Shapes
If Left(Shape.Name, 5) <> "Pictu" And Left(Shape.Name, 5) <> "Check" Then
Debug.Print Shape.Name
Debug.Print Shape.Type 'Type 12 is OLEObjects
Debug.Print Shape.TopLeftCell.Address
End If
Next Shape
' *******************************************************
' This Loops Only Through Type 12 Shapes (OLE Objects)
' *******************************************************
For i = 1 To Sheets("Original").OLEObjects.Count
Debug.Print TypeName(ActiveSheet.OLEObjects(i).Object)
If TypeName(ActiveSheet.OLEObjects(i).Object) = "OptionButton" Then
Debug.Print ActiveSheet.OLEObjects(i).Name
End If
Next i
End Sub
' *******************************************************
' Show All Possible Shape Types
' *******************************************************
Sub LoopThroughAllShapeTypes()
'Refers to each object on the current page and returns the Shapes.Type
'Can be very useful when searching through all objects on a page
Dim it As String
Dim i As Integer
Dim Ctr As Integer
'''''''''''''''''
'Read-only Long
'''''''''''''''''
For i = 1 To ActiveSheet.Shapes.Count
With ActiveSheet.Shapes(i)
Select Case .Type
'Type 1
Case msoAutoShape
it = "an AutoShape. Type : " & .Type
'Type 2
Case msoCallout
it = "a Callout. Type : " & .Type
'Type 3
Case msoChart
it = "a Chart. Type : " & .Type
'Type 4
Case msoComment
it = "a Comment. Type : " & .Type
'Type 5
Case msoFreeform
it = "a Freeform. Type : " & .Type
'Type 6
Case msoGroup
it = "a Group. Type : " & .Type
' If it's a group them iterate thru
' the items and list them
it = it & vbCrLf & "Comprised of..."
For Ctr = 1 To .GroupItems.Count
it = it & vbCrLf & _
.GroupItems(Ctr).Name & _
". Type:" & .GroupItems(Ctr).Type
Next Ctr
'Type 7
Case msoEmbeddedOLEObject
it = "an Embedded OLE Object. Type : " & .Type
'Type 8
Case msoFormControl
it = "a Form Control. Type : " & .Type
'Type 9
Case msoLine
it = "a Line. Type : " & .Type
'Type 10
Case msoLinkedOLEObject
it = "a Linked OLE Object. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 11
Case msoLinkedPicture
it = "a Linked Picture. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & "My Source: " & _
.SourceFullName
End With
'Type 12
Case msoOLEControlObject
it = "an OLE Control Object. Type : " & .Type
'Type 13
Case msoPicture
it = "a embedded picture. Type : " & .Type
'Type 14
Case msoPlaceholder
it = "a text placeholder (title or regular text--" & _
"not a standard textbox) object." & _
"Type : " & .Type
'Type 15
Case msoTextEffect
it = "a WordArt (Text Effect). Type : " & .Type
'Type 16
Case msoMedia
it = "a Media object .. sound, etc. Type : " & .Type
With .LinkFormat
it = it & vbCrLf & " My Source: " & _
.SourceFullName
End With
'Type 17
Case msoTextBox
it = "a Text Box."
'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
'Case msoScriptAnchor
Case 18
it = " a ScriptAnchor. Type : " & .Type
'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
'Case msoTable
Case 19
it = " a Table. Type : " & .Type
'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
'Case msoCanvas
Case 20
it = " a Canvas. Type : " & .Type
'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
'Case msoDiagram
Case 22
it = " a Diagram. Type : " & .Type
'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
'Case msoInk
Case 22
it = " an Ink shape. Type : " & .Type
'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
'Case msoInkComment
Case 23
it = " an InkComment. Type : " & .Type
'Type -2
Case msoShapeTypeMixed
it = "a Mixed object (whatever that might be)." & _
"Type : " & .Type
'Just in case
Case Else
it = "a mystery!? An undocumented object type?" & _
" Haven't found one of these yet!"
End Select
MsgBox ("I'm " & it)
End With
Next i
End Sub
Sub LoopThroughShapes()
Dim ws As Worksheet
Dim shp As Shape
' ****************************************************
' This Scans Through All Shapes... If a shape is an
' Active-X OLE Object, it displays the type, such
' As ComboBox, CommandButton, OptionButton, CheckBox
' ****************************************************
For Each ws In ActiveWorkbook.Worksheets
For Each shp In ws.Shapes
Debug.Print shp.Type
If shp.Type = 12 Then
Debug.Print TypeName(shp.OLEFormat.Object.Object)
End If
Next shp
Next ws
End Sub
