A rotina abaixo, originariamente no site Ozgrid.com; executa o que deseja,mas deve ser adaptada a sua realidade
Private 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
If wsLoop.Name = "Bandeiras" Then 'Altere aqui o nome de sua planilha
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 If
Next wsLoop
'AutoFit Columns.
WsNew.Columns.AutoFit
End Sub
Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel
Postado : 14/06/2018 5:34 am