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

    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 [email protected] 31 days after purchase date.

Instant Download and Money Back Guarantee on Most Software

Excel VBA Video Training/ EXCEL DASHBOARD REPORTS

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