Logicwurks Home Page

Links To Excel Code Examples

Range/Wkb/Wks Variables
Add Grand Totals Using Ranges
Using Range Offset Property
Using Range Find Method
Union Of Ranges
Parse Range Strings
Delete Duplicate Rows
Delete Rows And Columns
Worksheet Variables
TypeName And TypeOf
Loop Through Worksheets
Loop Through Open Workbooks
Form Button Magic
Command Button Magic
Add Worksheets Dynamically
Find Last Row Or Column
Copy And Paste Special
Copy To Specific Cell Types
Range Copy With Filter
Open An Excel File
Open An Excel File w/Params
Open An Excel File On Web
Save A Workbook
Clone A Workbook
Test If WEB URL Exists
Parse Using Split Command
Color Management
Convert Cell Color To RGB
Sort Methods 2003 - 2010
Sort Alpha/Numeric In ASCII
Search Using Match Function
Search Using Vlookup Function
Using Find Instead of Vlookup
Remove String Non-Printables
Auto_Open And Auto_Close
Initialize Form At Open
Edit Numerics In UserForm
Load Combo And List Boxes
Floating Sheet Combo Boxes
Advanced User Form Coding
Excel Events
Worksheet Change Events
Binary Search Of Array
Typecast Constants
Excel Error Handling
Handling Optional Parameters
Data Validation Drop Downs
Read A Text File w/Handle
Write A Text File w/Handle
Read A Text Fiile w/Script
Text File Processing Examples
Test For Exists Or Open
Splash Screen
Dynamically Load Formulas
Date Examples
Date Find Same Days
Convert Month To Number
Initialize Arrays
Load Arrays Using Evaluate
Redim An Array
Reassign Button Action
Timer Functions
Legacy Calendar Control
Excel 2010 Date Picker
Date Picker Alternative
Generate Multiple Worksheets
Read Access Data Into Excel
Send Outlook Email w/Attach
Copy AutoFilters To Sheets
Export A Text File
Get Windows User Name
VBA Format Statement
Manipulate Files via VBA
Dynamically Load Images
Loop Through Worksheet Objects
Loop Through Form Objects
Loop Through Files with DIR
Active-X Checkboxes
Add Forms Checkboxes Dynam
Paste Pictures Into Excel
Copy Pictures Sheet To Sheet
Copy Pictures Sheet To Sheet
Create Forms Buttons With VBA
Extract Filename From Path
Convert R1C1 Format to A1
Special Cells Property
Insert Cell Comments

Links To Access Code Examples

Create Recordset With AddNew
Multi-Select List Boxes
Update Field(s) In A Recordset
Import A Tab Delimited File
Export Excel FileDialog
Create Excel Within Access
Open Excel Within Access
Open Excel OBJ From Access
Format Excel From Access
Import Tab Delim w/WinAPI
Initialize Global Variables
Using TempVars For Globals
Access Error Handling
Loop Through Form Controls
Insert A Calendar Control
Create A Filtered Recordset
Populate Combo Boxes
Bookmarks And Forms
Combo Box Multiple Sources
Passing Form Objects
Create VBA SQL Statements
Create Dynamic Queries
Display File Images On A Form
Manipulate Files via VBA
Manipulate Files via Scripting
Number Subform Records
Reference Subform Objects
Parse Delimited Fields
Parameterized Queries (VBA)
Manipulating QueryDefs In VBA
FindFirst On Combined Keys
Dlookup Command
Dlookup In Form Datasheet
Execute SQL Delete Records
Commit Form To Table
Report With No Data
Reference Form Objects
DSNLess Connections To MySQL
Print Active Form Record
Count Records in Linked Tables
Delete Empty Tables
Open Linked SQL Tables


Loop Through Worksheet Shapes, Display Properties and Delete

This example show the syntax to loop through all the pictures in a worksheet, print some of their properties, and delete them. The next example shows how to loop through all shape objects, determine their type, and display their characteristics. The OLEEmbedded type 12 objects are then identified and properties are displayed (i.e. radio buttons and command buttons).

Program Code

Option Explicit

Public Sub LoopThroughPictures()
Dim Shape As Shape

For Each Shape In ActiveSheet.Shapes
    If Left(Shape.Name, 7) = "Picture" Then
        Debug.Print Shape.Name
        Debug.Print Shape.Left
        Debug.Print Shape.Top
        Debug.Print Shape.BottomRightCell.Address
        Debug.Print Shape.TopLeftCell.Address
    End If

End Sub

Public Sub LoopThroughObjectsExample()
Dim Shape As Shape
Dim i As Long
' *******************************************************
' This Loops Through All Shapes
' *******************************************************
For Each Shape In Sheets("Original").Shapes
    If Left(Shape.Name, 5) <> "Pictu" And Left(Shape.Name, 5) <> "Check" Then
        Debug.Print Shape.Name
        Debug.Print Shape.Type   'Type 12 is OLEObjects
        Debug.Print Shape.TopLeftCell.Address
    End If
Next Shape

' *******************************************************
' This Loops Only Through Type 12 Shapes (OLE Objects)
' *******************************************************
For i = 1 To Sheets("Original").OLEObjects.Count
    Debug.Print TypeName(ActiveSheet.OLEObjects(i).Object)
    If TypeName(ActiveSheet.OLEObjects(i).Object) = "OptionButton" Then
        Debug.Print ActiveSheet.OLEObjects(i).Name
    End If
Next i

End Sub

' *******************************************************
' Show All Possible Shape Types
' *******************************************************
Sub LoopThroughAllShapeTypes()
    'Refers to each object on the current page and returns the Shapes.Type
    'Can be very useful when searching through all objects on a page
    Dim it As String
    Dim i As Integer
    Dim Ctr As Integer
    'Read-only  Long
    For i = 1 To ActiveSheet.Shapes.Count
        With ActiveSheet.Shapes(i)

        Select Case .Type
            'Type 1
            Case msoAutoShape
                it = "an AutoShape. Type : " & .Type

            'Type 2
            Case msoCallout
                it = "a Callout. Type : " & .Type

            'Type 3
            Case msoChart
                it = "a Chart. Type : " & .Type

            'Type 4
            Case msoComment
                it = "a Comment. Type : " & .Type

            'Type 5
            Case msoFreeform
                it = "a Freeform. Type : " & .Type

            'Type 6
            Case msoGroup
                it = "a Group. Type : " & .Type

            ' If it's a group them iterate thru
            ' the items and list them

                it = it & vbCrLf & "Comprised of..."
                For Ctr = 1 To .GroupItems.Count
                    it = it & vbCrLf & _
                        .GroupItems(Ctr).Name & _
                        ". Type:" & .GroupItems(Ctr).Type
                Next Ctr

            'Type 7
            Case msoEmbeddedOLEObject
                it = "an Embedded OLE Object. Type : " & .Type

            'Type 8
            Case msoFormControl
                it = "a Form Control. Type : " & .Type

            'Type 9
            Case msoLine
                it = "a Line. Type : " & .Type

            'Type 10
            Case msoLinkedOLEObject
                it = "a Linked OLE Object. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                End With

            'Type 11
            Case msoLinkedPicture
                it = "a Linked Picture. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & "My Source: " & _
                End With

            'Type 12
            Case msoOLEControlObject
                it = "an OLE Control Object. Type : " & .Type

            'Type 13
            Case msoPicture
                it = "a embedded picture. Type : " & .Type

            'Type 14
            Case msoPlaceholder
                it = "a text placeholder (title or regular text--" & _
                     "not a standard textbox) object." & _
                     "Type : " & .Type

            'Type 15
            Case msoTextEffect
                it = "a WordArt (Text Effect). Type : " & .Type

            'Type 16
            Case msoMedia
                it = "a Media object .. sound, etc. Type : " & .Type
                With .LinkFormat
                    it = it & vbCrLf & " My Source: " & _
                End With

            'Type 17
            Case msoTextBox
                it = "a Text Box."

            'Type 18 = msoScriptAnchor, not defined in PPT pre-2000 so we use the numeric value
            'Case msoScriptAnchor
            Case 18
                it = " a ScriptAnchor. Type : " & .Type

            'Type 19 = msoTable, not defined in PPT pre-2000 so we use the numeric value
            'Case msoTable
            Case 19
                it = " a Table. Type : " & .Type

            'Type 19 = msoCanvas, not defined in PPT pre-2000 so we use the numeric value
            'Case msoCanvas
            Case 20
                it = " a Canvas. Type : " & .Type

            'Type 21 = msoDiagram, not defined in PPT pre-2000 so we use the numeric value
            'Case msoDiagram
            Case 22
                it = " a Diagram. Type : " & .Type

            'Type 22 = msoInk, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInk
            Case 22
                it = " an Ink shape. Type : " & .Type

            'Type 23 = msoInkComment, not defined in PPT pre-2000 so we use the numeric value
            'Case msoInkComment
            Case 23
                it = " an InkComment. Type : " & .Type

            'Type -2
            Case msoShapeTypeMixed
                it = "a Mixed object (whatever that might be)." & _
                     "Type : " & .Type

            'Just in case
            Case Else
                it = "a mystery!? An undocumented object type?" & _
                        " Haven't found one of these yet!"
        End Select

        MsgBox ("I'm " & it)
        End With
    Next i
End Sub

Sub LoopThroughShapes()
Dim ws As Worksheet
Dim shp As Shape
' ****************************************************
' This Scans Through All Shapes... If a shape is an
' Active-X OLE Object, it displays the type, such
' As ComboBox, CommandButton, OptionButton, CheckBox
' ****************************************************
For Each ws In ActiveWorkbook.Worksheets
        For Each shp In ws.Shapes
            Debug.Print shp.Type
            If shp.Type = 12 Then
                Debug.Print TypeName(shp.OLEFormat.Object.Object)
            End If
        Next shp
    Next ws
End Sub