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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
| Sub ListLinks(pFile As Workbook, ByRef numLinkedFiles As Variant)
Dim wb As Workbook, sh
Dim rng1 As Range, rng2 As Range, rng3 As Range, rArea As Range
Dim chr As ChartObject, chr1 As Chart
Dim chrSrs As Series
Dim PivCh As PivotTable
Dim FirstAddress As String, chrTitle As String
Dim ShProt As String
Dim nameCnt As Long
Dim FndRngLink As Boolean, FndChrLink As Boolean, FndNameLink As Boolean, FndPivLink As Boolean
Dim i As Long
Dim aLinks As Variant
Dim lnk As Variant
aLinks = pFile.LinkSources()
If Not IsEmpty(aLinks) Then
For Each lnk In aLinks
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_OLD_links", lnk, numLinkedFiles + 1
SetNamedRange "FILES_TYPE_links", "FORMULAS", numLinkedFiles + 1
numLinkedFiles = numLinkedFiles + 1
Next
End If
For Each sh In pFile.Sheets
Select Case sh.Type
Case xlWorksheet
If sh.ProtectContents = True Then
' Try unprotecting without password
sh.Unprotect ""
If sh.ProtectContents = True Then
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_sheets", sh.name, numLinkedFiles + 1
SetNamedRange "FILES_OLD_links", "WARNING: Cannot unprotect sheet -> Cannot check links.", numLinkedFiles
numLinkedFiles = numLinkedFiles + 1
GoTo nextSheet
End If
End If
'look at formula cells in each worksheet
Set rng1 = Nothing
Set rng2 = Nothing
Set rng3 = Nothing
' Charts
For Each chr In sh.ChartObjects
For Each chrSrs In chr.Chart.SeriesCollection
If InStr(chrSrs.Formula, ".xls") <> 0 Then
'look in open and closed workbooks
FndChrLink = True
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_sheets", sh.name, numLinkedFiles + 1
SetNamedRange "FILES_TYPE_links", "CHART SERIES", numLinkedFiles + 1
SetNamedRange "FILES_WHERE_links", chrSrs.name, numLinkedFiles + 1
SetNamedRange "FILES_WHAT_links", "'" & chrSrs.Formula, numLinkedFiles + 1
numLinkedFiles = numLinkedFiles + 1
End If
Next chrSrs
If chr.Chart.HasTitle Then
chr.Activate
chrTitle = CStr(ExecuteExcel4Macro("GET.FORMULA(""Title"")"))
If InStr(chrTitle, ".xls") <> 0 Then
'look in open and closed workbooks
FndChrLink = True
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_sheets", sh.name, numLinkedFiles + 1
SetNamedRange "FILES_TYPE_links", "CHART TITLE", numLinkedFiles + 1
SetNamedRange "FILES_WHERE_links", "Row " & chr.TopLeftCell.Row, numLinkedFiles + 1
SetNamedRange "FILES_WHAT_links", "'" & chrTitle, numLinkedFiles + 1
numLinkedFiles = numLinkedFiles + 1
End If
End If
Next chr
'Pivot Tables
For Each PivCh In sh.PivotTables
If InStr(PivCh.SourceData, ".xls") > 0 Then
'objFSOfile.writeline "Pivot Table," & PivCh.name & "," & sh.name & "," & Right$(aLinks(i), Len(aLinks(i)) - InStrRev(aLinks(i), "\")) & "," & aLinks(i) & ",'" & PivCh.SourceData
FndPivLink = True
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_sheets", sh.name, numLinkedFiles + 1
SetNamedRange "FILES_TYPE_links", "PIVOT TABLE SOURCE DATA", numLinkedFiles + 1
SetNamedRange "FILES_WHERE_links", PivCh.TableRange1(1, 1).Address, numLinkedFiles + 1
SetNamedRange "FILES_WHAT_links", PivCh.SourceData, numLinkedFiles + 1
numLinkedFiles = numLinkedFiles + 1
End If
Next
Case Else
MsgBox ("what is sheet with type '" & sh.Type & "'?")
End Select
nextSheet:
Next sh
'Named ranges
If pFile.Names.count = 0 Then
Else
For nameCnt = 1 To pFile.Names.count
If InStr(pFile.Names(nameCnt), ".xls") <> 0 Then
FndNameLink = True
SetNamedRange "FILES_files", "\" & pFile.name, numLinkedFiles + 1
SetNamedRange "FILES_TYPE_links", "DEFINED NAMES", numLinkedFiles + 1
SetNamedRange "FILES_WHERE_links", pFile.Names(nameCnt).NameLocal, numLinkedFiles + 1
SetNamedRange "FILES_WHAT_links", "'" & pFile.Names(nameCnt), numLinkedFiles + 1
numLinkedFiles = numLinkedFiles + 1
End If
Next nameCnt
End If
End Sub |