Working With Shapes In Excel VBA
Category: [Excel] Demo Available
Working With Shapes In Excel VBA
Shapes From Drawing Toolbar and Forms Toolbar
Got any Excel Questions? Free Excel Help
WORKING WITH SHAPES
Shapes are those from the Drawing toolbar or the Forms toolbar.
LISTING SHAPE PROPERTIES OF ACTIVE WORKSHEET
The code below will create a new Worksheet where the Shape Properties are listed under their appropriate heading.
Sub GetShapeProperties()
Dim sShapes As Shape, lLoop As Long
Dim wsStart As Worksheet, WsNew As Worksheet
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''LIST PROPERTIES OF SHAPES'''''''''''''
''''''''''Dave Hawley www.ozgrid.com''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set wsStart = ActiveSheet
Set WsNew = Sheets.Add
'Add headings for our lists. Expand as needed
WsNew.Range("A1:F1") = _
Array("Shape Name", "Shape Type", "Height", "Width", "Left", "Top")
'Loop through all shapes on active sheet
For Each sShapes In wsStart.Shapes
'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes
'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .Name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.Name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
'Follow the same pattern for more
End With
Next sShapes
'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub
LISTING SHAPE PROPERTIES OF ALL WORKSHEETS
The code below will create a new Worksheet where the Shape Properties from all Worksheets are listed under their appropriate heading.
Sub GetShapePropertiesAllWs()
Dim sShapes As Shape, lLoop As Long
Dim WsNew As Worksheet
Dim wsLoop As Worksheet
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''LIST PROPERTIES OF SHAPES'''''''''''''
''''''''''Dave Hawley www.ozgrid.com''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set WsNew = Sheets.Add
'Add headings for our lists. Expand as needed
WsNew.Range("A1:G1") = _
Array("Shape Name", "Shape Type", "Height", "Width", "Left", "Top", "Sheet Name")
'Loop through all Worksheet
For Each wsLoop In Worksheets
'Loop through all shapes on Worksheet
For Each sShapes In wsLoop.Shapes
'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes
'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
'Follow the same pattern for more
WsNew.Cells(lLoop + 1, 7) = wsLoop.name
End With
Next sShapes
Next wsLoop
'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub
LISTING SHAPE PROPERTIES OF SOME WORKSHEETS
The code below will create a new Worksheet where the Shape Properties from chosen Worksheets (those NOT named in Select Case) are listed under their appropriate heading.
Sub GetShapePropertiesSomeWs()
Dim sShapes As Shape, lLoop As Long
Dim WsNew As Worksheet
Dim wsLoop As Worksheet
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''LIST PROPERTIES OF SHAPES'''''''''''''
''''''''''Dave Hawley www.ozgrid.com''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Set WsNew = Sheets.Add
'Add headings for our lists. Expand as needed
WsNew.Range("A1:G1") = _
Array("Shape Name", "Shape Type", "Height", "Width", "Left", "Top", "Sheet Name")
'Loop through all Worksheet
For Each wsLoop In Worksheets
Select Case UCase(wsLoop.name)
Case "SHEET5", "SHEET8" 'add sheet names to exclude
'Do nothing
Case Else
'Loop through all shapes on Worksheet
For Each sShapes In wsLoop.Shapes
'Increment Variable lLoop for row numbers
lLoop = lLoop + 1
With sShapes
'Add shape properties
WsNew.Cells(lLoop + 1, 1) = .name
WsNew.Cells(lLoop + 1, 2) = .OLEFormat.Object.name
WsNew.Cells(lLoop + 1, 3) = .Height
WsNew.Cells(lLoop + 1, 4) = .Width
WsNew.Cells(lLoop + 1, 5) = .Left
WsNew.Cells(lLoop + 1, 6) = .Top
'Follow the same pattern for more
WsNew.Cells(lLoop + 1, 7) = wsLoop.name
End With
Next sShapes
End Select
Next wsLoop
'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub
Got any Excel/VBA Questions? Free Excel Help
See also:
| Index to Excel VBA Code |
See also Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions.
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.