 |
|
|
|
|
|
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
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 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 special@ozgrid.com 31 days after purchase date.
Instant Download and Money Back Guarantee on Most Software
Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!
Microsoft ® and Microsoft Excel ® are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft
GIVE YOURSELF OR YOUR COMPANY 24/7 MICROSOFT EXCEL SUPPORT & QUESTIONS