@@ -17,57 +17,54 @@ namespace Rubberduck.Inspections.Concrete
17
17
[ RequiredLibrary ( "Excel" ) ]
18
18
public class SheetAccessedUsingStringInspection : InspectionBase
19
19
{
20
- public SheetAccessedUsingStringInspection ( RubberduckParserState state ) : base ( state )
21
- {
22
- }
20
+ public SheetAccessedUsingStringInspection ( RubberduckParserState state ) : base ( state ) { }
23
21
24
- private static readonly string [ ] Targets =
22
+ private static readonly string [ ] InterestingMembers =
25
23
{
26
24
"Worksheets" , "Sheets"
27
25
} ;
28
26
27
+ private static readonly string [ ] InterestingClasses =
28
+ {
29
+ "_Global" , "_Application" , "Global" , "Application" , "Workbook"
30
+ } ;
31
+
29
32
protected override IEnumerable < IInspectionResult > DoGetInspectionResults ( )
30
33
{
31
34
var excel = State . DeclarationFinder . Projects . SingleOrDefault ( item => ! item . IsUserDefined && item . IdentifierName == "Excel" ) ;
32
35
if ( excel == null )
33
36
{
34
- return Enumerable . Empty < IInspectionResult > ( ) ;
35
-
37
+ return Enumerable . Empty < IInspectionResult > ( ) ;
36
38
}
37
39
38
- var modules = new [ ]
39
- {
40
- State . DeclarationFinder . FindClassModule ( "_Global" , excel , true ) ,
41
- State . DeclarationFinder . FindClassModule ( "_Application" , excel , true ) ,
42
- State . DeclarationFinder . FindClassModule ( "Global" , excel , true ) ,
43
- State . DeclarationFinder . FindClassModule ( "Application" , excel , true ) ,
44
- State . DeclarationFinder . FindClassModule ( "Workbook" , excel , true ) ,
45
- } ;
46
-
47
- var references = Targets
48
- . SelectMany ( target => modules . SelectMany ( module => State . DeclarationFinder . FindMemberMatches ( module , target ) ) )
49
- . Where ( declaration => declaration . References . Any ( ) )
50
- . SelectMany ( declaration => declaration . References
51
- . Where ( reference =>
52
- ! IsIgnoringInspectionResultFor ( reference , AnnotationName ) && IsAccessedWithStringLiteralParameter ( reference ) )
53
- . Select ( reference => new IdentifierReferenceInspectionResult ( this ,
54
- InspectionResults . SheetAccessedUsingStringInspection , State , reference ) ) ) ;
40
+ var targetProperties = BuiltInDeclarations
41
+ . OfType < PropertyDeclaration > ( )
42
+ . Where ( x => InterestingMembers . Contains ( x . IdentifierName ) && InterestingClasses . Contains ( x . ParentDeclaration ? . IdentifierName ) )
43
+ . ToList ( ) ;
44
+
45
+ var references = targetProperties . SelectMany ( declaration => declaration . References
46
+ . Where ( reference => ! IsIgnoringInspectionResultFor ( reference , AnnotationName ) &&
47
+ IsAccessedWithStringLiteralParameter ( reference ) )
48
+ . Select ( reference => new IdentifierReferenceInspectionResult ( this ,
49
+ InspectionResults . SheetAccessedUsingStringInspection , State , reference ) ) ) ;
55
50
56
51
var issues = new List < IdentifierReferenceInspectionResult > ( ) ;
57
52
58
53
foreach ( var reference in references )
59
54
{
60
- var component = GetVBComponentMatchingSheetName ( reference ) ;
61
- if ( component != null )
55
+ using ( var component = GetVBComponentMatchingSheetName ( reference ) )
62
56
{
57
+ if ( component == null )
58
+ {
59
+ continue ;
60
+ }
63
61
using ( var properties = component . Properties )
64
62
{
65
63
reference . Properties . CodeName = ( string ) properties . Single ( property => property . Name == "CodeName" ) . Value ;
66
64
}
67
65
issues . Add ( reference ) ;
68
66
}
69
67
}
70
-
71
68
return issues ;
72
69
}
73
70
@@ -101,47 +98,38 @@ private IVBComponent GetVBComponentMatchingSheetName(IdentifierReferenceInspecti
101
98
var sheetName = FormatSheetName ( sheetArgumentContext . GetText ( ) ) ;
102
99
var project = State . Projects . First ( p => p . ProjectId == reference . QualifiedName . ProjectId ) ;
103
100
104
-
105
- //return project.VBComponents.FirstOrDefault(c =>
106
- // c.Type == ComponentType.Document &&
107
- // (string)c.Properties.First(property => property.Name == "Name").Value == sheetName);
108
101
using ( var components = project . VBComponents )
109
102
{
110
- for ( var i = 0 ; i < components . Count ; i ++ )
103
+ foreach ( var component in components )
111
104
{
112
- using ( var component = components [ i ] )
113
105
using ( var properties = component . Properties )
114
106
{
115
- if ( component . Type = = ComponentType . Document )
107
+ if ( component . Type ! = ComponentType . Document )
116
108
{
117
- for ( var j = 0 ; j < properties . Count ; j ++ )
109
+ component . Dispose ( ) ;
110
+ continue ;
111
+ }
112
+ foreach ( var property in properties )
113
+ {
114
+ var found = property . Name . Equals ( "Name" ) && ( ( string ) property . Value ) . Equals ( sheetName ) ;
115
+ property . Dispose ( ) ;
116
+ if ( found )
118
117
{
119
- using ( var property = properties [ j ] )
120
- {
121
- if ( property . Name == "Name" && ( string ) property . Value == sheetName )
122
- {
123
- return component ;
124
- }
125
- }
126
- }
118
+ return component ;
119
+ }
127
120
}
128
121
}
122
+ component . Dispose ( ) ;
129
123
}
130
-
131
124
return null ;
132
125
}
133
126
}
134
127
135
128
private static string FormatSheetName ( string sheetName )
136
129
{
137
- var formattedName = sheetName . First ( ) == '"' ? sheetName . Skip ( 1 ) : sheetName ;
138
-
139
- if ( sheetName . Last ( ) == '"' )
140
- {
141
- formattedName = formattedName . Take ( formattedName . Count ( ) - 1 ) ;
142
- }
143
-
144
- return string . Concat ( formattedName ) ;
130
+ return sheetName . StartsWith ( "\" " ) && sheetName . EndsWith ( "\" " )
131
+ ? sheetName . Substring ( 1 , sheetName . Length - 2 )
132
+ : sheetName ;
145
133
}
146
134
}
147
135
}
0 commit comments