Excel VBA Video Training / EXCEL DASHBOARD REPORTS Working With Shapes In Excel VBA

Shapes From Drawing Toolbar and Forms Toolbar

Current Special! Complete Excel Excel Training Course for Excel 97 - Excel 2003, only \$145.00. \$59.95 Instant Buy/Download, 30 Day Money Back Guarantee & Free Excel Help for LIFE!

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

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

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''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''

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

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''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''''

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

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 Questions? Free Excel Help

Lot's More: Excel VBA

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over \$64.00. ALL purchases totaling over \$150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.