11_ExcelVBE/getOLEObjects.bas at master · AlignmentSystems/11_ExcelVBE · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Attribute VB_Name = "getOLEObjects"
Option Explicit
Option Compare Text
Option Base 0
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       5th April 2014
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================

Function EntryPointListOLEObjects()
'============================================================================================================================
'
'
'   Author      :       John Greenan
'   Email       :       john.greenan@alignment-systems.com
'   Company     :       Alignment Systems Limited
'   Date        :       5th April 2014
'
'   Purpose     :       Matching Engine in Excel VBA for Alignment Systems Limited
'
'   References  :       See VB Module FL for list extracted from VBE
'   References  :
'============================================================================================================================
'Constants
Const strMethodName As String = "getOLEObjects.EntryPointListOLEObjects "
Const strWorkSheetName As String = "WorksheetName="
Const strTypeName As String = " TypeName="
Const strProgID As String = " ProgID="
Const strVisible As String = " Visible?="
Const strObjectName As String = " Name="
Const strObjectObjectCaption As String = " Caption="
'Variables
Dim oWorkSheet As Excel.Worksheet
Dim oWorkbook As Excel.Workbook
Dim oObject As Excel.OLEObject
Dim strPrintString As String

Set oWorkbook = ThisWorkbook

For Each oWorkSheet In oWorkbook.Worksheets
    If oWorkSheet.OLEObjects.count = 0 Then
        Debug.Print oWorkSheet.Name & "--> has no OLEObjects"
    Else
        For Each oObject In oWorkSheet.OLEObjects
            strPrintString = strWorkSheetName & oWorkSheet.Name & strTypeName & TypeName(oObject) & strProgID & oObject.ProgID & strVisible & oObject.Visible & strObjectObjectCaption & oObject.Object.Caption

            If oObject.Name <> "" Then
                strPrintString = strPrintString & strObjectName & oObject.Name
            End If

            Debug.Print strPrintString
            strPrintString = ""
        Next
    End If
Next

End Function