1cdf0e10cSrcweirVERSION 1.0 CLASS 2cdf0e10cSrcweirBEGIN 3cdf0e10cSrcweir MultiUse = -1 'True 4cdf0e10cSrcweirEND 5cdf0e10cSrcweirAttribute VB_Name = "MigrationAnalyser" 6cdf0e10cSrcweirAttribute VB_GlobalNameSpace = False 7cdf0e10cSrcweirAttribute VB_Creatable = False 8cdf0e10cSrcweirAttribute VB_PredeclaredId = False 9cdf0e10cSrcweirAttribute VB_Exposed = False 10*d4a3fa4bSAndrew Rist'************************************************************************* 11*d4a3fa4bSAndrew Rist' 12*d4a3fa4bSAndrew Rist' Licensed to the Apache Software Foundation (ASF) under one 13*d4a3fa4bSAndrew Rist' or more contributor license agreements. See the NOTICE file 14*d4a3fa4bSAndrew Rist' distributed with this work for additional information 15*d4a3fa4bSAndrew Rist' regarding copyright ownership. The ASF licenses this file 16*d4a3fa4bSAndrew Rist' to you under the Apache License, Version 2.0 (the 17*d4a3fa4bSAndrew Rist' "License"); you may not use this file except in compliance 18*d4a3fa4bSAndrew Rist' with the License. You may obtain a copy of the License at 19*d4a3fa4bSAndrew Rist' 20*d4a3fa4bSAndrew Rist' http://www.apache.org/licenses/LICENSE-2.0 21*d4a3fa4bSAndrew Rist' 22*d4a3fa4bSAndrew Rist' Unless required by applicable law or agreed to in writing, 23*d4a3fa4bSAndrew Rist' software distributed under the License is distributed on an 24*d4a3fa4bSAndrew Rist' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 25*d4a3fa4bSAndrew Rist' KIND, either express or implied. See the License for the 26*d4a3fa4bSAndrew Rist' specific language governing permissions and limitations 27*d4a3fa4bSAndrew Rist' under the License. 28*d4a3fa4bSAndrew Rist' 29*d4a3fa4bSAndrew Rist'************************************************************************* 30cdf0e10cSrcweirOption Explicit 31cdf0e10cSrcweir 32cdf0e10cSrcweirConst CWORKBOOK_SHEETS_LIMIT = 256 33cdf0e10cSrcweir 34cdf0e10cSrcweir'Class variables 35cdf0e10cSrcweirPrivate Enum HFIssueType 36cdf0e10cSrcweir hfInline 37cdf0e10cSrcweir hfShape 38cdf0e10cSrcweir hfFrame 39cdf0e10cSrcweirEnd Enum 40cdf0e10cSrcweir 41cdf0e10cSrcweirPrivate Enum HFIssueLocation 42cdf0e10cSrcweir hfHeader 43cdf0e10cSrcweir hfFooter 44cdf0e10cSrcweirEnd Enum 45cdf0e10cSrcweir 46cdf0e10cSrcweirPrivate Type CellAtrributes 47cdf0e10cSrcweir LineStyle As Integer 48cdf0e10cSrcweir FillPattern As Integer 49cdf0e10cSrcweirEnd Type 50cdf0e10cSrcweir 51cdf0e10cSrcweirPrivate Type BadSheetNameChar 52cdf0e10cSrcweir BadChar As String 53cdf0e10cSrcweir Position As Integer 54cdf0e10cSrcweirEnd Type 55cdf0e10cSrcweir 56cdf0e10cSrcweirPrivate mAnalysis As DocumentAnalysis 57cdf0e10cSrcweirPrivate mFileName As String 58cdf0e10cSrcweir 59cdf0e10cSrcweirConst RID_STR_EXCEL_SUBISSUE_ERROR_TYPE = "ERROR.TYPE" 60cdf0e10cSrcweirConst RID_STR_EXCEL_SUBISSUE_INFO = "INFO" 61cdf0e10cSrcweirConst RID_STR_EXCEL_SUBISSUE_DATEDIF = "DATEDIF" 62cdf0e10cSrcweirConst RID_STR_EXCEL_SUBISSUE_PHONETIC = "PHONETIC" 63cdf0e10cSrcweirConst FontError = 94 64cdf0e10cSrcweirConst CR_BADCHAR = "<TOKEN1>" 65cdf0e10cSrcweirConst CR_BADCHARNUM = "<TOKEN2>" 66cdf0e10cSrcweirConst DATA_SOURCE_EXCEL = 0 67cdf0e10cSrcweirConst DATA_SOURCE_EXTERNAL = 1 68cdf0e10cSrcweirConst DATA_SOURCE_MULTIPLE = 2 69cdf0e10cSrcweirConst DATA_SOURCE_EXTERNAL_FILE = 3 70cdf0e10cSrcweirConst C_MAX_CELL_RANGE_COUNT = 10000 71cdf0e10cSrcweir 72cdf0e10cSrcweirPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 73cdf0e10cSrcweir 74cdf0e10cSrcweir'***ADDING-ISSUE: Use Following Skeleton as Guideline for Adding Issue 75cdf0e10cSrcweir' For complete list of all RID_STR_... for Issues (IssueType), SubIssues (SubType) and Attributes refer to: 76cdf0e10cSrcweir' excel_res.bas and common_res.bas 77cdf0e10cSrcweir' 78cdf0e10cSrcweir' For complete list of all CID_... for Issue Categories(IssueID) and 79cdf0e10cSrcweir' CSTR_... for XML Issues (IssueTypeXML) and XML SubIssues (SubTypeXML) refer to: 80cdf0e10cSrcweir' ApplicationSpecific.bas and CommonMigrationAnalyser.bas 81cdf0e10cSrcweir' 82cdf0e10cSrcweir' You should not have to add any new Issue Categories or matching IssueTypes, only new SubIssues 83cdf0e10cSrcweirSub Analyze_SKELETON() 84cdf0e10cSrcweir On Error GoTo HandleErrors 85cdf0e10cSrcweir Dim currentFunctionName As String 86cdf0e10cSrcweir currentFunctionName = "Analyze_SKELETON" 87cdf0e10cSrcweir Dim myIssue As IssueInfo 88cdf0e10cSrcweir Set myIssue = New IssueInfo 89cdf0e10cSrcweir 90cdf0e10cSrcweir With myIssue 91cdf0e10cSrcweir .IssueID = CID_VBA_MACROS 'Issue Category 92cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 'Issue String 93cdf0e10cSrcweir .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 'SubIssue String 94cdf0e10cSrcweir .Location = .CLocationDocument 'Location string 95cdf0e10cSrcweir 96cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 'Non localised XML Issue String 97cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 'Non localised XML SubIssue String 98cdf0e10cSrcweir .locationXML = .CXMLLocationDocument 'Non localised XML location 99cdf0e10cSrcweir 100cdf0e10cSrcweir .SubLocation = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 101cdf0e10cSrcweir .Line = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 102cdf0e10cSrcweir .column = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 103cdf0e10cSrcweir 104cdf0e10cSrcweir ' Add as many Attribute Value pairs as needed 105cdf0e10cSrcweir ' Note: following must always be true - Attributes.Count = Values.Count 106cdf0e10cSrcweir .Attributes.Add "AAA" 107cdf0e10cSrcweir .Values.Add "foobar" 108cdf0e10cSrcweir 109cdf0e10cSrcweir ' Use AddIssueDetailsNote to add notes to the Issue Details if required 110cdf0e10cSrcweir ' Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _ 111cdf0e10cSrcweir ' Optional preStr As String = RID_STR_COMMON_NOTE_PRE) 112cdf0e10cSrcweir ' Where preStr is prepended to the output, with "Note" as the default 113cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_NOTE_DOCUMENT_PROPERTIES_LOST 114cdf0e10cSrcweir 115cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_VBA_MACROS) = _ 116cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1 117cdf0e10cSrcweir End With 118cdf0e10cSrcweir 119cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 120cdf0e10cSrcweir 121cdf0e10cSrcweirFinalExit: 122cdf0e10cSrcweir Set myIssue = Nothing 123cdf0e10cSrcweir Exit Sub 124cdf0e10cSrcweir 125cdf0e10cSrcweirHandleErrors: 126cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 127cdf0e10cSrcweir Resume FinalExit 128cdf0e10cSrcweirEnd Sub 129cdf0e10cSrcweir 130cdf0e10cSrcweirSub DoAnalyse(fileName As String, userFormTypesDict As Scripting.Dictionary, _ 131cdf0e10cSrcweir startDir As String, storeToDir As String, fso As FileSystemObject) 132cdf0e10cSrcweir On Error GoTo HandleErrors 133cdf0e10cSrcweir Dim currentFunctionName As String 134cdf0e10cSrcweir currentFunctionName = "DoAnalyse" 135cdf0e10cSrcweir 'Dim secAutomation As MsoAutomationSecurity 136cdf0e10cSrcweir 'secAutomation = Application.AutomationSecurity 137cdf0e10cSrcweir 138cdf0e10cSrcweir mAnalysis.name = fileName 139cdf0e10cSrcweir Dim aWB As Workbook 140cdf0e10cSrcweir mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES 141cdf0e10cSrcweir 142cdf0e10cSrcweir 'Make Excel run as non interactively as possible 143cdf0e10cSrcweir Application.EnableEvents = False 144cdf0e10cSrcweir Application.DisplayAlerts = False 145cdf0e10cSrcweir Application.Interactive = False 146cdf0e10cSrcweir Application.AskToUpdateLinks = False 147cdf0e10cSrcweir Application.EnableAnimations = False 148cdf0e10cSrcweir Application.EnableSound = False 149cdf0e10cSrcweir 150cdf0e10cSrcweir 'Only supported in Office XP and above 151cdf0e10cSrcweir 'Application.AutomationSecurity = msoAutomationSecurityForceDisable 152cdf0e10cSrcweir 'mFileName = fso.GetFileName(fileName) 153cdf0e10cSrcweir 'WriteToLog "TmpDebug1", mFileName 154cdf0e10cSrcweir 155cdf0e10cSrcweir Dim myPassword As String 156cdf0e10cSrcweir 157cdf0e10cSrcweir myPassword = GetDefaultPassword 158cdf0e10cSrcweir 159cdf0e10cSrcweir If myPassword = "" Then 160cdf0e10cSrcweir myPassword = "xoxoxoxoxo" 161cdf0e10cSrcweir End If 162cdf0e10cSrcweir 163cdf0e10cSrcweir Set aWB = Workbooks.Open(fileName:=fileName, _ 164cdf0e10cSrcweir Password:=myPassword, _ 165cdf0e10cSrcweir WriteResPassword:=myPassword, _ 166cdf0e10cSrcweir UpdateLinks:=0) 167cdf0e10cSrcweir 168cdf0e10cSrcweir 'Application.AutomationSecurity = secAutomation 169cdf0e10cSrcweir 170cdf0e10cSrcweir 'Do Analysis 171cdf0e10cSrcweir Analyze_Password_Protection aWB 172cdf0e10cSrcweir Analyze_Workbook_Protection aWB 173cdf0e10cSrcweir 174cdf0e10cSrcweir 'Set Doc Properties 175cdf0e10cSrcweir SetDocProperties mAnalysis, aWB, fso 176cdf0e10cSrcweir 177cdf0e10cSrcweir Analyze_SheetLimits aWB 178cdf0e10cSrcweir Analyze_SheetDisplay aWB 179cdf0e10cSrcweir Analyze_SheetIssues aWB 180cdf0e10cSrcweir Analyze_SheetCharts aWB 181cdf0e10cSrcweir Analyze_WorkbookVersion aWB 182cdf0e10cSrcweir Analyze_Macros mAnalysis, userFormTypesDict, aWB 183cdf0e10cSrcweir 184cdf0e10cSrcweir ' Doc Preparation only 185cdf0e10cSrcweir ' Save document with any fixed issues under <storeToDir>\prepared\<source doc name> 186cdf0e10cSrcweir If mAnalysis.PreparableIssuesCount > 0 And CheckDoPrepare Then 187cdf0e10cSrcweir Dim preparedFullPath As String 188cdf0e10cSrcweir preparedFullPath = GetPreparedFullPath(mAnalysis.name, startDir, storeToDir, fso) 189cdf0e10cSrcweir If preparedFullPath <> "" Then 190cdf0e10cSrcweir If fso.FileExists(preparedFullPath) Then 191cdf0e10cSrcweir fso.DeleteFile preparedFullPath, True 192cdf0e10cSrcweir End If 193cdf0e10cSrcweir If fso.FolderExists(fso.GetParentFolderName(preparedFullPath)) Then 194cdf0e10cSrcweir If IsOldVersion(aWB.FileFormat) Then 195cdf0e10cSrcweir aWB.SaveAs fileName:=preparedFullPath, FileFormat:=xlExcel9795 196cdf0e10cSrcweir Else 197cdf0e10cSrcweir aWB.SaveAs preparedFullPath 198cdf0e10cSrcweir End If 199cdf0e10cSrcweir End If 200cdf0e10cSrcweir End If 201cdf0e10cSrcweir End If 202cdf0e10cSrcweir 203cdf0e10cSrcweirFinalExit: 204cdf0e10cSrcweir If Not aWB Is Nothing Then 205cdf0e10cSrcweir aWB.Close (False) 206cdf0e10cSrcweir End If 207cdf0e10cSrcweir 208cdf0e10cSrcweir Set aWB = Nothing 209cdf0e10cSrcweir 210cdf0e10cSrcweir Application.EnableEvents = True 211cdf0e10cSrcweir Application.DisplayAlerts = True 212cdf0e10cSrcweir Application.Interactive = True 213cdf0e10cSrcweir Application.AskToUpdateLinks = True 214cdf0e10cSrcweir Application.EnableAnimations = True 215cdf0e10cSrcweir Application.EnableSound = True 216cdf0e10cSrcweir 217cdf0e10cSrcweir 'Debug - Call Sleep(5000) 218cdf0e10cSrcweir Exit Sub 219cdf0e10cSrcweir 220cdf0e10cSrcweirHandleErrors: 221cdf0e10cSrcweir ' MsgBox currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 222cdf0e10cSrcweir ' Handle Password error on Doc Open, Modify and Cancel 223cdf0e10cSrcweir If Err.Number = 1004 Then 224cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & fileName & ": " & _ 225cdf0e10cSrcweir "User entered Invalid Document Password - " & Err.Number & " " & Err.Description & " " & Err.Source 226cdf0e10cSrcweir HandleProtectedDocInvalidPassword mAnalysis, _ 227cdf0e10cSrcweir "User entered Invalid Document Password, further analysis not possible", fso 228cdf0e10cSrcweir Resume FinalExit 229cdf0e10cSrcweir End If 230cdf0e10cSrcweir mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN 231cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source 232cdf0e10cSrcweir Resume FinalExit 233cdf0e10cSrcweirEnd Sub 234cdf0e10cSrcweir 235cdf0e10cSrcweirSub Analyze_SheetCharts(aWB As Workbook) 236cdf0e10cSrcweir On Error GoTo HandleErrors 237cdf0e10cSrcweir Dim currentFunctionName As String 238cdf0e10cSrcweir currentFunctionName = "Analyze_SheetCharts" 239cdf0e10cSrcweir 240cdf0e10cSrcweir Dim myChartSheet As Chart 241cdf0e10cSrcweir 242cdf0e10cSrcweir For Each myChartSheet In aWB.Charts 243cdf0e10cSrcweir SetChartIssueMinor myChartSheet, myChartSheet.name, False 244cdf0e10cSrcweir SetChartIssueComplex myChartSheet, myChartSheet.name 245cdf0e10cSrcweir Next myChartSheet 246cdf0e10cSrcweir 247cdf0e10cSrcweir Exit Sub 248cdf0e10cSrcweirHandleErrors: 249cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 250cdf0e10cSrcweirEnd Sub 251cdf0e10cSrcweir 252cdf0e10cSrcweirSub Analyze_EmbeddedCharts(mySheet As Worksheet) 253cdf0e10cSrcweir On Error GoTo HandleErrors 254cdf0e10cSrcweir Dim currentFunctionName As String 255cdf0e10cSrcweir currentFunctionName = "Analyze_EmbeddedCharts" 256cdf0e10cSrcweir Dim BorderIssue As Boolean 257cdf0e10cSrcweir 258cdf0e10cSrcweir Dim index As Integer 259cdf0e10cSrcweir BorderIssue = False 260cdf0e10cSrcweir Dim chartcount As Integer 261cdf0e10cSrcweir Dim myChart As Chart 262cdf0e10cSrcweir 263cdf0e10cSrcweir chartcount = mySheet.ChartObjects.count 264cdf0e10cSrcweir 265cdf0e10cSrcweir For index = 1 To chartcount 266cdf0e10cSrcweir BorderIssue = False 267cdf0e10cSrcweir With mySheet.ChartObjects(index) 268cdf0e10cSrcweir If .Border.LineStyle <> xlLineStyleNone Then 269cdf0e10cSrcweir BorderIssue = True 270cdf0e10cSrcweir End If 271cdf0e10cSrcweir SetChartIssueMinor .Chart, mySheet.name, BorderIssue 272cdf0e10cSrcweir 'If Not ((.ChartType = xlSurface) _ 273cdf0e10cSrcweir ' And (.ChartType = xlSurfaceTopViewWireframe) _ 274cdf0e10cSrcweir ' And (.ChartType = xlSurfaceTopView)) Then 275cdf0e10cSrcweir SetChartIssueComplex .Chart, mySheet.name 276cdf0e10cSrcweir 'End If 277cdf0e10cSrcweir End With 278cdf0e10cSrcweir Next index 279cdf0e10cSrcweir 280cdf0e10cSrcweir Exit Sub 281cdf0e10cSrcweirHandleErrors: 282cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 283cdf0e10cSrcweirEnd Sub 284cdf0e10cSrcweir 285cdf0e10cSrcweirPrivate Function getType(o As Variant) As Integer 286cdf0e10cSrcweir If (VarType(o) = vbString) Then 287cdf0e10cSrcweir Dim aDataSource As String 288cdf0e10cSrcweir aDataSource = o 289cdf0e10cSrcweir getType = DATA_SOURCE_EXCEL 290cdf0e10cSrcweir If (Len(aDataSource) > 0) Then 291cdf0e10cSrcweir Dim nBackslashPos As Long 292cdf0e10cSrcweir nBackslashPos = InStr(Trim(aDataSource), "\") 293cdf0e10cSrcweir If (nBackslashPos > 0 And nBackslashPos < 4) Then 294cdf0e10cSrcweir getType = DATA_SOURCE_EXTERNAL_FILE 295cdf0e10cSrcweir End If 296cdf0e10cSrcweir End If 297cdf0e10cSrcweir ElseIf (IsArray(o)) Then 298cdf0e10cSrcweir If (hasSecondDimension(o)) Then 299cdf0e10cSrcweir getType = DATA_SOURCE_MULTIPLE 300cdf0e10cSrcweir Else 301cdf0e10cSrcweir getType = DATA_SOURCE_EXTERNAL 302cdf0e10cSrcweir End If 303cdf0e10cSrcweir End If 304cdf0e10cSrcweirEnd Function 305cdf0e10cSrcweir 306cdf0e10cSrcweirPrivate Function hasSecondDimension(o2 As Variant) As Boolean 307cdf0e10cSrcweir On Error GoTo njet 308cdf0e10cSrcweir Dim temp As Integer 309cdf0e10cSrcweir temp = UBound(o2, 2) 310cdf0e10cSrcweir hasSecondDimension = True 311cdf0e10cSrcweir Exit Function 312cdf0e10cSrcweirnjet: 313cdf0e10cSrcweir hasSecondDimension = False 314cdf0e10cSrcweirEnd Function 315cdf0e10cSrcweir 316cdf0e10cSrcweirPrivate Sub Analyze_PivotTable(myIssue As IssueInfo, myPivotTable As PivotTable) 317cdf0e10cSrcweir On Error GoTo HandleErrors 318cdf0e10cSrcweir Dim currentFunctionName As String 319cdf0e10cSrcweir currentFunctionName = "Analyse_PivotTable" 320cdf0e10cSrcweir 321cdf0e10cSrcweir Dim aPivotField As PivotField 322cdf0e10cSrcweir Dim aNoteCount As Long 323cdf0e10cSrcweir Dim bManualSort As Boolean 324cdf0e10cSrcweir Dim bCalculatedValues As Boolean 325cdf0e10cSrcweir Dim aSorting As XlSortOrder 326cdf0e10cSrcweir Dim nCount As Integer 327cdf0e10cSrcweir Dim nDataSource As Integer 328cdf0e10cSrcweir 329cdf0e10cSrcweir bManualSort = False 330cdf0e10cSrcweir bCalculatedValues = False 331cdf0e10cSrcweir 332cdf0e10cSrcweir For Each aPivotField In myPivotTable.PivotFields 333cdf0e10cSrcweir aSorting = xlAscending 334cdf0e10cSrcweir 335cdf0e10cSrcweir On Error Resume Next 'some fields don't have any property at all 336cdf0e10cSrcweir aSorting = aPivotField.AutoSortOrder 337cdf0e10cSrcweir On Error GoTo HandleErrors 338cdf0e10cSrcweir 339cdf0e10cSrcweir If (aSorting = xlManual) Then 340cdf0e10cSrcweir bManualSort = True 341cdf0e10cSrcweir End If 342cdf0e10cSrcweir 343cdf0e10cSrcweir nCount = 0 344cdf0e10cSrcweir 345cdf0e10cSrcweir On Error Resume Next 'some fields don't have any property at all 346cdf0e10cSrcweir nCount = aPivotField.CalculatedItems.count 347cdf0e10cSrcweir On Error GoTo HandleErrors 348cdf0e10cSrcweir 349cdf0e10cSrcweir If (nCount > 0) Then 350cdf0e10cSrcweir bCalculatedValues = True 351cdf0e10cSrcweir End If 352cdf0e10cSrcweir Next 353cdf0e10cSrcweir 354cdf0e10cSrcweir nCount = 0 355cdf0e10cSrcweir 356cdf0e10cSrcweir On Error Resume Next 'some fields don't have any property at all 357cdf0e10cSrcweir nCount = myPivotTable.CalculatedFields.count 358cdf0e10cSrcweir On Error GoTo HandleErrors 359cdf0e10cSrcweir 360cdf0e10cSrcweir If (nCount > 0) Then 361cdf0e10cSrcweir bCalculatedValues = True 362cdf0e10cSrcweir End If 363cdf0e10cSrcweir 364cdf0e10cSrcweir nDataSource = getType(myPivotTable.SourceData) 365cdf0e10cSrcweir 366cdf0e10cSrcweir aNoteCount = 0 367cdf0e10cSrcweir 368cdf0e10cSrcweir If (bManualSort) Then 369cdf0e10cSrcweir AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_ManSort_Comment 370cdf0e10cSrcweir aNoteCount = aNoteCount + 1 371cdf0e10cSrcweir End If 372cdf0e10cSrcweir 373cdf0e10cSrcweir If (nDataSource = DATA_SOURCE_EXTERNAL) Then 374cdf0e10cSrcweir AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_ExternData_Comment 375cdf0e10cSrcweir aNoteCount = aNoteCount + 1 376cdf0e10cSrcweir ElseIf (nDataSource = DATA_SOURCE_MULTIPLE) Then 377cdf0e10cSrcweir AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_MultConsRanges_Comment 378cdf0e10cSrcweir aNoteCount = aNoteCount + 1 379cdf0e10cSrcweir ElseIf (nDataSource = DATA_SOURCE_EXTERNAL_FILE) Then 380cdf0e10cSrcweir Dim noteString As String 381cdf0e10cSrcweir noteString = RID_RESXLT_COST_PIVOT_ExternData_Comment & "[" & _ 382cdf0e10cSrcweir myPivotTable.SourceData & "]" 383cdf0e10cSrcweir AddIssueDetailsNote myIssue, aNoteCount, noteString 384cdf0e10cSrcweir aNoteCount = aNoteCount + 1 385cdf0e10cSrcweir End If 386cdf0e10cSrcweir 387cdf0e10cSrcweir If (bCalculatedValues) Then 388cdf0e10cSrcweir AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_CalcVal_Comment 389cdf0e10cSrcweir aNoteCount = aNoteCount + 1 390cdf0e10cSrcweir End If 391cdf0e10cSrcweir 392cdf0e10cSrcweirFinalExit: 393cdf0e10cSrcweir Exit Sub 394cdf0e10cSrcweir 395cdf0e10cSrcweirHandleErrors: 396cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 397cdf0e10cSrcweir Resume FinalExit 398cdf0e10cSrcweirEnd Sub 399cdf0e10cSrcweir 400cdf0e10cSrcweirPrivate Sub SetChartIssueComplex(myChart As Chart, myName As String) 401cdf0e10cSrcweir On Error GoTo HandleErrors 402cdf0e10cSrcweir Dim currentFunctionName As String 403cdf0e10cSrcweir currentFunctionName = "SetChartIssueComplex" 404cdf0e10cSrcweir 405cdf0e10cSrcweir Dim myIssue As IssueInfo 406cdf0e10cSrcweir Dim bSeriesChartTypeChanged As Boolean 407cdf0e10cSrcweir Dim bDatasourceNotLinkedtoCell As Boolean 408cdf0e10cSrcweir Dim bDatasourceOnDifferentSheet As Boolean 409cdf0e10cSrcweir Dim bCategoryandValue As Boolean 410cdf0e10cSrcweir Dim bCLabelMorethanOneCell As Boolean 411cdf0e10cSrcweir Dim bOneColumnRow As Boolean 412cdf0e10cSrcweir Dim bDataTable As Boolean 413cdf0e10cSrcweir Dim bXAxes As Boolean 414cdf0e10cSrcweir Dim bseries As Boolean 415cdf0e10cSrcweir Dim bformat As Boolean 416cdf0e10cSrcweir Dim bpivot As Boolean 417cdf0e10cSrcweir 418cdf0e10cSrcweir 419cdf0e10cSrcweir Set myIssue = New IssueInfo 420cdf0e10cSrcweir bSeriesChartTypeChanged = False 421cdf0e10cSrcweir bDatasourceNotLinkedtoCell = False 422cdf0e10cSrcweir bDatasourceOnDifferentSheet = False 423cdf0e10cSrcweir bCategoryandValue = False 424cdf0e10cSrcweir bCLabelMorethanOneCell = False 425cdf0e10cSrcweir bOneColumnRow = False 426cdf0e10cSrcweir bDataTable = False 427cdf0e10cSrcweir bXAxes = False 428cdf0e10cSrcweir 429cdf0e10cSrcweir bformat = FormatIssueComplex(myChart, bDataTable, bXAxes) 430cdf0e10cSrcweir bseries = SeriesIssue(myChart, bSeriesChartTypeChanged, bDatasourceNotLinkedtoCell, bDatasourceOnDifferentSheet, bCategoryandValue, bCLabelMorethanOneCell, bOneColumnRow) 431cdf0e10cSrcweir bpivot = Not (myChart.PivotLayout Is Nothing) 432cdf0e10cSrcweir 433cdf0e10cSrcweir If (Not (bseries Or bformat Or bpivot)) Then 434cdf0e10cSrcweir GoTo FinalExit 435cdf0e10cSrcweir ElseIf bpivot Then 436cdf0e10cSrcweir With myIssue 437cdf0e10cSrcweir .IssueID = CID_CHARTS_TABLES 438cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES 439cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_PIVOT 440cdf0e10cSrcweir .Location = .CLocationSheet 441cdf0e10cSrcweir .SubLocation = myName 442cdf0e10cSrcweir 443cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES 444cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_CHART_PIVOT 445cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 446cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_TABLE_NAME 447cdf0e10cSrcweir .Values.Add myChart.PivotLayout.PivotTable.name 448cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_VISIBLE 449cdf0e10cSrcweir .Values.Add myChart.HasPivotFields 450cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_NUM 451cdf0e10cSrcweir .Values.Add myChart.PivotLayout.PivotTable.PivotFields.count 452cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE 453cdf0e10cSrcweir .Values.Add getChartTypeAsString(myChart.ChartType) 454cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME 455cdf0e10cSrcweir .Values.Add myChart.name 456cdf0e10cSrcweir End With 457cdf0e10cSrcweir 458cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_RESXLT_COST_PIVOT_PivotChart_Comment 459cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _ 460cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1 461cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 462cdf0e10cSrcweir 463cdf0e10cSrcweir GoTo FinalExit 464cdf0e10cSrcweir Else 465cdf0e10cSrcweir With myIssue 466cdf0e10cSrcweir Dim NoteIndex As Long 467cdf0e10cSrcweir NoteIndex = 0 468cdf0e10cSrcweir 469cdf0e10cSrcweir .IssueID = CID_CHARTS_TABLES 470cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES 471cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_CHART_COMPLEX 472cdf0e10cSrcweir .Location = .CLocationSheet 473cdf0e10cSrcweir .SubLocation = myName 474cdf0e10cSrcweir 475cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES 476cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_CHART_COMPLEX 477cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 478cdf0e10cSrcweir 479cdf0e10cSrcweir If bDataTable Then 480cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATATABLE 481cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 482cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATATABLE 483cdf0e10cSrcweir NoteIndex = NoteIndex + 1 484cdf0e10cSrcweir End If 485cdf0e10cSrcweir If bXAxes Then 486cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_XAXISCATEGORY 487cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_TIMESCALE 488cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_XAXISCATEGORY 489cdf0e10cSrcweir NoteIndex = NoteIndex + 1 490cdf0e10cSrcweir End If 491cdf0e10cSrcweir If bSeriesChartTypeChanged Then 492cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_SERIESCHARTTYPE 493cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_CHANGED 494cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_SERIESCHARTTYPE 495cdf0e10cSrcweir NoteIndex = NoteIndex + 1 496cdf0e10cSrcweir End If 497cdf0e10cSrcweir If bDatasourceNotLinkedtoCell Then 498cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCE 499cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCENOTLINKEDTOCELL 500cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATASOURCENOTLINKEDTOCELL 501cdf0e10cSrcweir NoteIndex = NoteIndex + 1 502cdf0e10cSrcweir End If 503cdf0e10cSrcweir If bDatasourceOnDifferentSheet Then 504cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCE 505cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCEONDIFFERENTSHEET 506cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATASOURCEONDIFFERENTSHEET 507cdf0e10cSrcweir NoteIndex = NoteIndex + 1 508cdf0e10cSrcweir End If 509cdf0e10cSrcweir If bCategoryandValue Then 510cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYANDDATA 511cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SEPARATE 512cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_CATEGORYANDDATA 513cdf0e10cSrcweir NoteIndex = NoteIndex + 1 514cdf0e10cSrcweir End If 515cdf0e10cSrcweir If bCLabelMorethanOneCell Then 516cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYLABEL 517cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYLABELMORETHANONECELL 518cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_CATEGORYLABELMORETHANONECELL 519cdf0e10cSrcweir NoteIndex = NoteIndex + 1 520cdf0e10cSrcweir End If 521cdf0e10cSrcweir If bOneColumnRow Then 522cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_COLUMNBAR 523cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_ONECOLUMNROW 524cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_COLUMNBAR 525cdf0e10cSrcweir NoteIndex = NoteIndex + 1 526cdf0e10cSrcweir End If 527cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE 528cdf0e10cSrcweir .Values.Add getChartTypeAsString(myChart.ChartType) 529cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME 530cdf0e10cSrcweir .Values.Add myChart.name 531cdf0e10cSrcweir End With 532cdf0e10cSrcweir 533cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _ 534cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1 535cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 536cdf0e10cSrcweir End If 537cdf0e10cSrcweirFinalExit: 538cdf0e10cSrcweir Set myIssue = Nothing 539cdf0e10cSrcweir Exit Sub 540cdf0e10cSrcweir 541cdf0e10cSrcweirHandleErrors: 542cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 543cdf0e10cSrcweir Resume FinalExit 544cdf0e10cSrcweirEnd Sub 545cdf0e10cSrcweir 546cdf0e10cSrcweirPrivate Sub SetChartIssueMinor(myChart As Chart, myName As String, BorderIssue As Boolean) 547cdf0e10cSrcweir On Error GoTo HandleErrors 548cdf0e10cSrcweir Dim currentFunctionName As String 549cdf0e10cSrcweir currentFunctionName = "SetChartIssueMinor" 550cdf0e10cSrcweir 551cdf0e10cSrcweir Dim myIssue As IssueInfo 552cdf0e10cSrcweir Dim bUnsupportedType As Boolean 553cdf0e10cSrcweir Dim bTrendline As Boolean 554cdf0e10cSrcweir Dim bDatalabelWithLegend As Boolean 555cdf0e10cSrcweir Dim bLegendPosition As Boolean 556cdf0e10cSrcweir Dim bTitleFont As Boolean 557cdf0e10cSrcweir Dim bPiechartDirection As Boolean 558cdf0e10cSrcweir Dim bAxisInterval As Boolean 559cdf0e10cSrcweir 560cdf0e10cSrcweir 561cdf0e10cSrcweir Set myIssue = New IssueInfo 562cdf0e10cSrcweir bUnsupportedType = False 563cdf0e10cSrcweir bTrendline = False 564cdf0e10cSrcweir bDatalabelWithLegend = False 565cdf0e10cSrcweir bLegendPosition = False 566cdf0e10cSrcweir bTitleFont = False 567cdf0e10cSrcweir bPiechartDirection = False 568cdf0e10cSrcweir bAxisInterval = False 569cdf0e10cSrcweir 570cdf0e10cSrcweir 571cdf0e10cSrcweir If (Not FormatissueMinor(myChart, bUnsupportedType, bTrendline, bDatalabelWithLegend, bLegendPosition, bTitleFont, bPiechartDirection, bAxisInterval)) And (Not BorderIssue) Then 572cdf0e10cSrcweir GoTo FinalExit 573cdf0e10cSrcweir Else 574cdf0e10cSrcweir With myIssue 575cdf0e10cSrcweir Dim NoteIndex As Long 576cdf0e10cSrcweir NoteIndex = 0 577cdf0e10cSrcweir 578cdf0e10cSrcweir .IssueID = CID_CHARTS_TABLES 579cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES 580cdf0e10cSrcweir 581cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_CHART_MINOR 582cdf0e10cSrcweir .Location = .CLocationSheet 583cdf0e10cSrcweir .SubLocation = myName 584cdf0e10cSrcweir 585cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES 586cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_CHART_PIVOT 587cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 588cdf0e10cSrcweir 589cdf0e10cSrcweir If bUnsupportedType Then 590cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_UNSUPPORTEDTYPE 591cdf0e10cSrcweir .Values.Add getChartTypeAsString(myChart.ChartType) 592cdf0e10cSrcweir ' bubble chart 593cdf0e10cSrcweir If (myChart.ChartType = xlBubble Or myChart.ChartType = xlBubble3DEffect) Then 594cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Bubble_Comment 595cdf0e10cSrcweir ' bar of pie and pie of pie chart 596cdf0e10cSrcweir ElseIf (myChart.ChartType = xlPieOfPie Or myChart.ChartType = xlBarOfPie) Then 597cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_BarOfPie_Comment 598cdf0e10cSrcweir ' Scatter chart 599cdf0e10cSrcweir ElseIf (myChart.ChartType = xlXYScatter Or myChart.ChartType = xlXYScatterLines _ 600cdf0e10cSrcweir Or myChart.ChartType = xlXYScatterLinesNoMarkers _ 601cdf0e10cSrcweir Or myChart.ChartType = xlXYScatterSmooth _ 602cdf0e10cSrcweir Or myChart.ChartType = xlXYScatterSmoothNoMarkers) Then 603cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Scattered_Comment 604cdf0e10cSrcweir ' radar chart 605cdf0e10cSrcweir ElseIf (myChart.ChartType = xlRadarMarkers Or myChart.ChartType = xlRadar) Then 606cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Radar_Comment 607cdf0e10cSrcweir ' radar filled chart 608cdf0e10cSrcweir ElseIf (myChart.ChartType = xlRadarFilled) Then 609cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_FilledRadar_Comment 610cdf0e10cSrcweir ' surface chart 611cdf0e10cSrcweir ElseIf (myChart.ChartType = xlSurface Or myChart.ChartType = xlSurfaceTopView _ 612cdf0e10cSrcweir Or myChart.ChartType = xlSurfaceTopViewWireframe _ 613cdf0e10cSrcweir Or myChart.ChartType = xlSurfaceWireframe) Then 614cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Surface_Comment 615cdf0e10cSrcweir Else 616cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_UNSUPPORTEDTYPE1 617cdf0e10cSrcweir NoteIndex = NoteIndex + 1 618cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_UNSUPPORTEDTYPE2 619cdf0e10cSrcweir End If 620cdf0e10cSrcweir NoteIndex = NoteIndex + 1 621cdf0e10cSrcweir End If 622cdf0e10cSrcweir If bTrendline Then 623cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TRENDLINE 624cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 625cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_TRENDLINE 626cdf0e10cSrcweir NoteIndex = NoteIndex + 1 627cdf0e10cSrcweir End If 628cdf0e10cSrcweir If bDatalabelWithLegend Then 629cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATALABELWITHLEGEND 630cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 631cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATALABELWITHLEGEND 632cdf0e10cSrcweir NoteIndex = NoteIndex + 1 633cdf0e10cSrcweir End If 634cdf0e10cSrcweir If bLegendPosition Then 635cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_LEGENDPOSITION 636cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_NOTRIGHT 637cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_LEGENDPOSITION 638cdf0e10cSrcweir NoteIndex = NoteIndex + 1 639cdf0e10cSrcweir End If 640cdf0e10cSrcweir If bTitleFont Then 641cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TITLEFONT 642cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_DIFFERENT 643cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_TITLEFONT 644cdf0e10cSrcweir NoteIndex = NoteIndex + 1 645cdf0e10cSrcweir End If 646cdf0e10cSrcweir If bPiechartDirection Then 647cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIE 648cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SLICES_IN_DIFFERENT_DIRECTION 649cdf0e10cSrcweir End If 650cdf0e10cSrcweir If BorderIssue Then 651cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_BORDER 652cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 653cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_BORDER 654cdf0e10cSrcweir NoteIndex = NoteIndex + 1 655cdf0e10cSrcweir End If 656cdf0e10cSrcweir If bAxisInterval Then 657cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_AXISINTERVAL 658cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_AUTO 659cdf0e10cSrcweir AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_AXISINTERVAL 660cdf0e10cSrcweir NoteIndex = NoteIndex + 1 661cdf0e10cSrcweir End If 662cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME 663cdf0e10cSrcweir .Values.Add myChart.name 664cdf0e10cSrcweir End With 665cdf0e10cSrcweir 666cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _ 667cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1 668cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 669cdf0e10cSrcweir End If 670cdf0e10cSrcweirFinalExit: 671cdf0e10cSrcweir Set myIssue = Nothing 672cdf0e10cSrcweir Exit Sub 673cdf0e10cSrcweir 674cdf0e10cSrcweirHandleErrors: 675cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 676cdf0e10cSrcweir Resume FinalExit 677cdf0e10cSrcweirEnd Sub 678cdf0e10cSrcweir 679cdf0e10cSrcweirSub SetChartIssue(myChart As Chart, myName As String, strSubType As String, _ 680cdf0e10cSrcweir strXMLSubType As String) 681cdf0e10cSrcweir On Error GoTo HandleErrors 682cdf0e10cSrcweir Dim currentFunctionName As String 683cdf0e10cSrcweir currentFunctionName = "SetChartIssue" 684cdf0e10cSrcweir Dim myIssue As IssueInfo 685cdf0e10cSrcweir Dim bUnsupportedPosition As Boolean 686cdf0e10cSrcweir 687cdf0e10cSrcweir Set myIssue = New IssueInfo 688cdf0e10cSrcweir 689cdf0e10cSrcweir ' Common Settings 690cdf0e10cSrcweir With myIssue 691cdf0e10cSrcweir .IssueID = CID_CHARTS_TABLES 692cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES 693cdf0e10cSrcweir .SubType = strSubType 694cdf0e10cSrcweir .Location = .CLocationSheet 695cdf0e10cSrcweir .SubLocation = myName 696cdf0e10cSrcweir 697cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES 698cdf0e10cSrcweir .SubTypeXML = strXMLSubType 699cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 700cdf0e10cSrcweir 701cdf0e10cSrcweir 702cdf0e10cSrcweir If myChart.HasTitle Then 703cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TITLE 704cdf0e10cSrcweir .Values.Add myChart.chartTitle.Text 705cdf0e10cSrcweir End If 706cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE 707cdf0e10cSrcweir .Values.Add myChart.ChartType 'TBD - getChartTypeAsString() convert to String 708cdf0e10cSrcweir 709cdf0e10cSrcweir 'Pie Chart 710cdf0e10cSrcweir If (myChart.ChartType = xlPie) Or _ 711cdf0e10cSrcweir (myChart.ChartType = xlPieExploded) Or _ 712cdf0e10cSrcweir (myChart.ChartType = xlPieOfPie) Or _ 713cdf0e10cSrcweir (myChart.ChartType = xl3DPie) Or _ 714cdf0e10cSrcweir (myChart.ChartType = xl3DPieExploded) Then 715cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIE 716cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SLICES_IN_DIFFERENT_DIRECTION 717cdf0e10cSrcweir End If 718cdf0e10cSrcweir 719cdf0e10cSrcweir If Not myChart.PivotLayout Is Nothing Then 720cdf0e10cSrcweir 'Pivot Chart 721cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_PIVOT & " " & strSubType 722cdf0e10cSrcweir 723cdf0e10cSrcweir 'Pivot Chart details 724cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_TABLE_NAME 725cdf0e10cSrcweir .Values.Add myChart.PivotLayout.PivotTable.name 726cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_VISIBLE 727cdf0e10cSrcweir .Values.Add myChart.HasPivotFields 728cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_NUM 729cdf0e10cSrcweir .Values.Add myChart.PivotLayout.PivotTable.PivotFields.count 730cdf0e10cSrcweir End If 731cdf0e10cSrcweir End With 732cdf0e10cSrcweir 733cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _ 734cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1 735cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 736cdf0e10cSrcweir 737cdf0e10cSrcweirFinalExit: 738cdf0e10cSrcweir Set myIssue = Nothing 739cdf0e10cSrcweir Exit Sub 740cdf0e10cSrcweir 741cdf0e10cSrcweirHandleErrors: 742cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 743cdf0e10cSrcweir Resume FinalExit 744cdf0e10cSrcweirEnd Sub 745cdf0e10cSrcweir 746cdf0e10cSrcweirFunction getLineStyleAsString(myLineStyle As XlLineStyle) As String 747cdf0e10cSrcweir 748cdf0e10cSrcweir On Error GoTo HandleErrors 749cdf0e10cSrcweir Dim currentFunctionName As String 750cdf0e10cSrcweir currentFunctionName = "getLineStyleAsString" 751cdf0e10cSrcweir 752cdf0e10cSrcweir Dim strVal As String 753cdf0e10cSrcweir 754cdf0e10cSrcweir Select Case myLineStyle 755cdf0e10cSrcweir Case xlContinuous 756cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_CONTINUOUS 757cdf0e10cSrcweir Case xlDash 758cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DASH 759cdf0e10cSrcweir Case xlDashDot 760cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DASHDOT 761cdf0e10cSrcweir Case xlDot 762cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DOT 763cdf0e10cSrcweir Case xlDouble 764cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DOUBLE 765cdf0e10cSrcweir Case xlSlantDashDot 766cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_SLANTDASHDOT 767cdf0e10cSrcweir Case xlLineStyleNone 768cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_LINESTYLENONE 769cdf0e10cSrcweir Case Else 770cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_UNKNOWN 771cdf0e10cSrcweir End Select 772cdf0e10cSrcweir 773cdf0e10cSrcweir 774cdf0e10cSrcweir getLineStyleAsString = strVal 775cdf0e10cSrcweirHandleErrors: 776cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 777cdf0e10cSrcweirEnd Function 778cdf0e10cSrcweir 779cdf0e10cSrcweirFunction getChartTypeAsString(myChartType As XlChartType) As String 780cdf0e10cSrcweir '********************************************************* 781cdf0e10cSrcweir '**** Localisation: ON HOLD ****************************** 782cdf0e10cSrcweir '********************************************************* 783cdf0e10cSrcweir On Error GoTo HandleErrors 784cdf0e10cSrcweir Dim currentFunctionName As String 785cdf0e10cSrcweir currentFunctionName = "getChartTypeAsString" 786cdf0e10cSrcweir 787cdf0e10cSrcweir Dim strVal As String 788cdf0e10cSrcweir 789cdf0e10cSrcweir Select Case myChartType 790cdf0e10cSrcweir Case xl3DArea 791cdf0e10cSrcweir strVal = "3DArea" 792cdf0e10cSrcweir Case xl3DAreaStacked 793cdf0e10cSrcweir strVal = "3DAreaStacked" 794cdf0e10cSrcweir Case xl3DAreaStacked100 795cdf0e10cSrcweir strVal = "3DAreaStacked100" 796cdf0e10cSrcweir Case xl3DBarClustered 797cdf0e10cSrcweir strVal = "3DBarClustered" 798cdf0e10cSrcweir Case xl3DBarStacked 799cdf0e10cSrcweir strVal = "xl3DBarStacked" 800cdf0e10cSrcweir Case xl3DBarStacked100 801cdf0e10cSrcweir strVal = "xl3DBarStacked100" 802cdf0e10cSrcweir Case xl3DColumn 803cdf0e10cSrcweir strVal = "3DColumn" 804cdf0e10cSrcweir Case xl3DColumnClustered 805cdf0e10cSrcweir strVal = "xl3DColumnClustered" 806cdf0e10cSrcweir Case xl3DColumnStacked 807cdf0e10cSrcweir strVal = "xl3DColumnStacked" 808cdf0e10cSrcweir Case xl3DColumnStacked100 809cdf0e10cSrcweir strVal = "xl3DColumnStacked100" 810cdf0e10cSrcweir Case xl3DLine 811cdf0e10cSrcweir strVal = "3DLine" 812cdf0e10cSrcweir Case xl3DPie 813cdf0e10cSrcweir strVal = "3DPie" 814cdf0e10cSrcweir Case xl3DPieExploded 815cdf0e10cSrcweir strVal = "3DPieExploded" 816cdf0e10cSrcweir Case xlArea 817cdf0e10cSrcweir strVal = "Area" 818cdf0e10cSrcweir Case xlAreaStacked 819cdf0e10cSrcweir strVal = "AreaStacked" 820cdf0e10cSrcweir Case xlAreaStacked100 821cdf0e10cSrcweir strVal = "AreaStacked100" 822cdf0e10cSrcweir Case xlBarClustered 823cdf0e10cSrcweir strVal = "BarClustered" 824cdf0e10cSrcweir Case xlBarOfPie 825cdf0e10cSrcweir strVal = "BarOfPie" 826cdf0e10cSrcweir Case xlBarStacked 827cdf0e10cSrcweir strVal = "BarStacked" 828cdf0e10cSrcweir Case xlBarStacked100 829cdf0e10cSrcweir strVal = "BarStacked100" 830cdf0e10cSrcweir Case xlBubble 831cdf0e10cSrcweir strVal = "Bubble" 832cdf0e10cSrcweir Case xlBubble3DEffect 833cdf0e10cSrcweir strVal = "Bubble3DEffect" 834cdf0e10cSrcweir Case xlColumnClustered 835cdf0e10cSrcweir strVal = "ColumnClustered" 836cdf0e10cSrcweir Case xlColumnStacked 837cdf0e10cSrcweir strVal = "ColumnStacked" 838cdf0e10cSrcweir Case xlColumnStacked100 839cdf0e10cSrcweir strVal = "ColumnStacked100" 840cdf0e10cSrcweir Case xlConeBarClustered 841cdf0e10cSrcweir strVal = "ConeBarClustered" 842cdf0e10cSrcweir Case xlConeBarStacked 843cdf0e10cSrcweir strVal = "ConeBarStacked" 844cdf0e10cSrcweir Case xlConeBarStacked100 845cdf0e10cSrcweir strVal = "ConeBarStacked100" 846cdf0e10cSrcweir Case xlConeCol 847cdf0e10cSrcweir strVal = "ConeCol" 848cdf0e10cSrcweir Case xlConeColClustered 849cdf0e10cSrcweir strVal = "ConeColClustered" 850cdf0e10cSrcweir Case xlConeColStacked 851cdf0e10cSrcweir strVal = "ConeColStacked" 852cdf0e10cSrcweir Case xlConeColStacked100 853cdf0e10cSrcweir strVal = "ConeColStacked100" 854cdf0e10cSrcweir Case xlCylinderBarClustered 855cdf0e10cSrcweir strVal = "CylinderBarClustered" 856cdf0e10cSrcweir Case xlCylinderBarStacked 857cdf0e10cSrcweir strVal = "CylinderBarStacked" 858cdf0e10cSrcweir Case xlCylinderBarStacked100 859cdf0e10cSrcweir strVal = "CylinderBarStacked100" 860cdf0e10cSrcweir Case xlCylinderCol 861cdf0e10cSrcweir strVal = "CylinderCol" 862cdf0e10cSrcweir Case xlCylinderColClustered 863cdf0e10cSrcweir strVal = "CylinderColClustered" 864cdf0e10cSrcweir Case xlCylinderColStacked 865cdf0e10cSrcweir strVal = "CylinderColStacked" 866cdf0e10cSrcweir Case xlCylinderColStacked100 867cdf0e10cSrcweir strVal = "CylinderColStacked100" 868cdf0e10cSrcweir Case xlDoughnut 869cdf0e10cSrcweir strVal = "Doughnut" 870cdf0e10cSrcweir Case xlLine 871cdf0e10cSrcweir strVal = "Line" 872cdf0e10cSrcweir Case xlLineMarkers 873cdf0e10cSrcweir strVal = "LineMarkers" 874cdf0e10cSrcweir Case xlLineMarkersStacked 875cdf0e10cSrcweir strVal = "LineMarkersStacked" 876cdf0e10cSrcweir Case xlLineMarkersStacked100 877cdf0e10cSrcweir strVal = "LineMarkersStacked100" 878cdf0e10cSrcweir Case xlLineStacked 879cdf0e10cSrcweir strVal = "LineStacked" 880cdf0e10cSrcweir Case xlLineStacked100 881cdf0e10cSrcweir strVal = "LineStacked100" 882cdf0e10cSrcweir Case xlPie 883cdf0e10cSrcweir strVal = "Pie" 884cdf0e10cSrcweir Case xlPieExploded 885cdf0e10cSrcweir strVal = "PieExploded" 886cdf0e10cSrcweir Case xlPieOfPie 887cdf0e10cSrcweir strVal = "PieOfPie" 888cdf0e10cSrcweir Case xlPyramidBarClustered 889cdf0e10cSrcweir strVal = "PyramidBarClustered" 890cdf0e10cSrcweir Case xlPyramidBarStacked 891cdf0e10cSrcweir strVal = "PyramidBarStacked" 892cdf0e10cSrcweir Case xlPyramidBarStacked100 893cdf0e10cSrcweir strVal = "PyramidBarStacked100" 894cdf0e10cSrcweir Case xlPyramidCol 895cdf0e10cSrcweir strVal = "PyramidCol" 896cdf0e10cSrcweir Case xlPyramidColClustered 897cdf0e10cSrcweir strVal = "PyramidColClustered" 898cdf0e10cSrcweir Case xlPyramidColStacked 899cdf0e10cSrcweir strVal = "PyramidColStacked" 900cdf0e10cSrcweir Case xlPyramidColStacked100 901cdf0e10cSrcweir strVal = "PyramidColStacked100" 902cdf0e10cSrcweir Case xlRadar 903cdf0e10cSrcweir strVal = "Radar" 904cdf0e10cSrcweir Case xlRadarFilled 905cdf0e10cSrcweir strVal = "RadarFilled" 906cdf0e10cSrcweir Case xlRadarMarkers 907cdf0e10cSrcweir strVal = "RadarMarkers" 908cdf0e10cSrcweir Case xlStockHLC 909cdf0e10cSrcweir strVal = "StockHLC" 910cdf0e10cSrcweir Case xlStockOHLC 911cdf0e10cSrcweir strVal = "StockOHLC" 912cdf0e10cSrcweir Case xlStockVHLC 913cdf0e10cSrcweir strVal = "StockVHLC" 914cdf0e10cSrcweir Case xlStockVOHLC 915cdf0e10cSrcweir strVal = "StockVOHLC" 916cdf0e10cSrcweir Case xlSurface 917cdf0e10cSrcweir strVal = "Surface" 918cdf0e10cSrcweir Case xlSurfaceTopView 919cdf0e10cSrcweir strVal = "SurfaceTopView" 920cdf0e10cSrcweir Case xlSurfaceTopViewWireframe 921cdf0e10cSrcweir strVal = "SurfaceTopViewWireframe" 922cdf0e10cSrcweir Case xlSurfaceWireframe 923cdf0e10cSrcweir strVal = "SurfaceWireframe" 924cdf0e10cSrcweir Case xlXYScatter 925cdf0e10cSrcweir strVal = "XYScatter" 926cdf0e10cSrcweir Case xlXYScatterLines 927cdf0e10cSrcweir strVal = "XYScatterLines" 928cdf0e10cSrcweir Case xlXYScatterLinesNoMarkers 929cdf0e10cSrcweir strVal = "XYScatterLinesNoMarkers" 930cdf0e10cSrcweir Case xlXYScatterSmooth 931cdf0e10cSrcweir strVal = "XYScatterSmooth" 932cdf0e10cSrcweir Case xlXYScatterSmoothNoMarkers 933cdf0e10cSrcweir strVal = "XYScatterSmoothNoMarkers" 934cdf0e10cSrcweir Case Else 935cdf0e10cSrcweir strVal = RID_STR_EXCEL_ENUMERATION_UNKNOWN 936cdf0e10cSrcweir End Select 937cdf0e10cSrcweir 938cdf0e10cSrcweir getChartTypeAsString = strVal 939cdf0e10cSrcweir 940cdf0e10cSrcweir Exit Function 941cdf0e10cSrcweir 942cdf0e10cSrcweirHandleErrors: 943cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 944cdf0e10cSrcweirEnd Function 945cdf0e10cSrcweir 946cdf0e10cSrcweirSub HandleZoomIssue(currentSheet) 947cdf0e10cSrcweir Dim myIssue As IssueInfo 948cdf0e10cSrcweir Dim currentFunctionName As String 949cdf0e10cSrcweir currentFunctionName = "HandleZoomIssue" 950cdf0e10cSrcweir 951cdf0e10cSrcweir On Error GoTo HandleErrors 952cdf0e10cSrcweir 953cdf0e10cSrcweir Set myIssue = New IssueInfo 954cdf0e10cSrcweir With myIssue 955cdf0e10cSrcweir .IssueID = CID_FORMAT 956cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_FORMAT 957cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_ZOOM 958cdf0e10cSrcweir .Location = .CLocationSheet 959cdf0e10cSrcweir .SubLocation = currentSheet.name 960cdf0e10cSrcweir 961cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_FORMAT 962cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_ZOOM 963cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 964cdf0e10cSrcweir 965cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_ZOOM 966cdf0e10cSrcweir End With 967cdf0e10cSrcweir 968cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FORMAT) = _ 969cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FORMAT) + 1 970cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 971cdf0e10cSrcweir 972cdf0e10cSrcweirFinalExit: 973cdf0e10cSrcweir Set myIssue = Nothing 974cdf0e10cSrcweir Exit Sub 975cdf0e10cSrcweir 976cdf0e10cSrcweirHandleErrors: 977cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 978cdf0e10cSrcweir Resume FinalExit 979cdf0e10cSrcweirEnd Sub 980cdf0e10cSrcweir 981cdf0e10cSrcweirSub Analyze_SheetDisplay(aWB As Workbook) 982cdf0e10cSrcweir On Error GoTo HandleErrors 983cdf0e10cSrcweir Dim currentFunctionName As String 984cdf0e10cSrcweir currentFunctionName = "Analyze_SheetDisplay" 985cdf0e10cSrcweir 986cdf0e10cSrcweir If aWB.Sheets.count = 1 Then Exit Sub 987cdf0e10cSrcweir 988cdf0e10cSrcweir Dim lastZoomVal As Integer 989cdf0e10cSrcweir Dim bInitZoom As Boolean 990cdf0e10cSrcweir Dim bZoomChanged As Boolean 991cdf0e10cSrcweir Dim ws As Object 992cdf0e10cSrcweir 993cdf0e10cSrcweir bInitZoom = True 994cdf0e10cSrcweir bZoomChanged = False 995cdf0e10cSrcweir 996cdf0e10cSrcweir For Each ws In aWB.Sheets 997cdf0e10cSrcweir ws.Activate 998cdf0e10cSrcweir 999cdf0e10cSrcweir On Error GoTo HandleErrors 1000cdf0e10cSrcweir 1001cdf0e10cSrcweir If bInitZoom Then 1002cdf0e10cSrcweir lastZoomVal = ActiveWindow.Zoom 1003cdf0e10cSrcweir bInitZoom = False 1004cdf0e10cSrcweir ElseIf Not bZoomChanged Then 1005cdf0e10cSrcweir If ActiveWindow.Zoom <> lastZoomVal Then 1006cdf0e10cSrcweir bZoomChanged = True 1007cdf0e10cSrcweir HandleZoomIssue ws 1008cdf0e10cSrcweir End If 1009cdf0e10cSrcweir End If 1010cdf0e10cSrcweir If bZoomChanged Then Exit For 1011cdf0e10cSrcweir Next ws 1012cdf0e10cSrcweir 1013cdf0e10cSrcweirFinalExit: 1014cdf0e10cSrcweir Exit Sub 1015cdf0e10cSrcweir 1016cdf0e10cSrcweirHandleErrors: 1017cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1018cdf0e10cSrcweir Resume FinalExit 1019cdf0e10cSrcweirEnd Sub 1020cdf0e10cSrcweir 1021cdf0e10cSrcweirSub Analyze_SheetLimits(aWB As Workbook) 1022cdf0e10cSrcweir On Error GoTo HandleErrors 1023cdf0e10cSrcweir Dim currentFunctionName As String 1024cdf0e10cSrcweir currentFunctionName = "Analyze_SheetLimits" 1025cdf0e10cSrcweir Dim myIssue As IssueInfo 1026cdf0e10cSrcweir 1027cdf0e10cSrcweir If aWB.Sheets.count < CWORKBOOK_SHEETS_LIMIT + 1 Then Exit Sub 1028cdf0e10cSrcweir 1029cdf0e10cSrcweir Set myIssue = New IssueInfo 1030cdf0e10cSrcweir With myIssue 1031cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1032cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1033cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_MAX_SHEETS_EXCEEDED 1034cdf0e10cSrcweir .Location = .CLocationWorkBook 1035cdf0e10cSrcweir .SubLocation = aWB.name 1036cdf0e10cSrcweir 1037cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1038cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_MAX_SHEETS_EXCEEDED 1039cdf0e10cSrcweir .locationXML = .CXMLLocationWorkBook 1040cdf0e10cSrcweir 1041cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_SHEETS 1042cdf0e10cSrcweir .Values.Add aWB.Sheets.count 1043cdf0e10cSrcweir 1044cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_SHEET_LIMITS_1 & CWORKBOOK_SHEETS_LIMIT 1045cdf0e10cSrcweir AddIssueDetailsNote myIssue, 1, RID_STR_EXCEL_NOTE_SHEET_LIMITS_2 & CWORKBOOK_SHEETS_LIMIT 1046cdf0e10cSrcweir End With 1047cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1048cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1049cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1050cdf0e10cSrcweir Set myIssue = Nothing 1051cdf0e10cSrcweir 1052cdf0e10cSrcweirFinalExit: 1053cdf0e10cSrcweir Set myIssue = Nothing 1054cdf0e10cSrcweir Exit Sub 1055cdf0e10cSrcweir 1056cdf0e10cSrcweirHandleErrors: 1057cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1058cdf0e10cSrcweir Resume FinalExit 1059cdf0e10cSrcweirEnd Sub 1060cdf0e10cSrcweir 1061cdf0e10cSrcweirSub Analyze_SheetIssues(aWB As Workbook) 1062cdf0e10cSrcweir On Error GoTo HandleErrors 1063cdf0e10cSrcweir Dim currentFunctionName As String 1064cdf0e10cSrcweir currentFunctionName = "Analyze_SheetIssues" 1065cdf0e10cSrcweir 1066cdf0e10cSrcweir Dim myWrkSheet As Worksheet 1067cdf0e10cSrcweir 1068cdf0e10cSrcweir For Each myWrkSheet In aWB.Worksheets 1069cdf0e10cSrcweir Analyze_OLEEmbedded myWrkSheet 1070cdf0e10cSrcweir Analyze_CellInSheetIssues myWrkSheet 1071cdf0e10cSrcweir Analyze_EmbeddedCharts myWrkSheet 1072cdf0e10cSrcweir Analyze_SheetName myWrkSheet 1073cdf0e10cSrcweir Analyze_QueryTables myWrkSheet 1074cdf0e10cSrcweir Next myWrkSheet 1075cdf0e10cSrcweir 1076cdf0e10cSrcweir Exit Sub 1077cdf0e10cSrcweirHandleErrors: 1078cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1079cdf0e10cSrcweirEnd Sub 1080cdf0e10cSrcweir 1081cdf0e10cSrcweirSub Analyze_SheetName(mySheet As Worksheet) 1082cdf0e10cSrcweir On Error GoTo HandleErrors 1083cdf0e10cSrcweir Dim currentFunctionName As String 1084cdf0e10cSrcweir currentFunctionName = "Analyze_SheetName" 1085cdf0e10cSrcweir Dim myIssue As IssueInfo 1086cdf0e10cSrcweir Set myIssue = New IssueInfo 1087cdf0e10cSrcweir 1088cdf0e10cSrcweir Dim invalidCharacters As String 1089cdf0e10cSrcweir invalidCharacters = InvalidSheetNameCharacters(mySheet.name) 1090cdf0e10cSrcweir If Len(invalidCharacters) <> 0 Then 1091cdf0e10cSrcweir With myIssue 1092cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1093cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1094cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_INVALID_WORKSHEET_NAME 1095cdf0e10cSrcweir .Location = .CLocationSheet 1096cdf0e10cSrcweir .SubLocation = mySheet.name 1097cdf0e10cSrcweir 1098cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1099cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_INVALID_WORKSHEET_NAME 1100cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 1101cdf0e10cSrcweir 1102cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_INVALIDCHARACTER 1103cdf0e10cSrcweir .Values.Add invalidCharacters 1104cdf0e10cSrcweir 1105cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_INVALIDWORKSHEETNAME 1106cdf0e10cSrcweir 1107cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1108cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1109cdf0e10cSrcweir End With 1110cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1111cdf0e10cSrcweir End If 1112cdf0e10cSrcweir 1113cdf0e10cSrcweirFinalExit: 1114cdf0e10cSrcweir Set myIssue = Nothing 1115cdf0e10cSrcweir Exit Sub 1116cdf0e10cSrcweir 1117cdf0e10cSrcweirHandleErrors: 1118cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1119cdf0e10cSrcweir Resume FinalExit 1120cdf0e10cSrcweirEnd Sub 1121cdf0e10cSrcweir 1122cdf0e10cSrcweirFunction InvalidSheetNameCharacters(aName As String) As String 1123cdf0e10cSrcweir On Error GoTo HandleErrors 1124cdf0e10cSrcweir Dim currentFunctionName As String 1125cdf0e10cSrcweir currentFunctionName = "InvalidSheetNameCharacters" 1126cdf0e10cSrcweir 1127cdf0e10cSrcweir Dim I As Integer 1128cdf0e10cSrcweir Dim NameCount As Integer 1129cdf0e10cSrcweir Dim newBadCharLine As String 1130cdf0e10cSrcweir Dim invalidCharacterDetails As String 1131cdf0e10cSrcweir Dim BadCharPosition As String 1132cdf0e10cSrcweir Dim theBadChars As BadSheetNameChar 1133cdf0e10cSrcweir NameCount = Len(aName) 1134cdf0e10cSrcweir invalidCharacterDetails = "" 1135cdf0e10cSrcweir For I = 1 To NameCount 1136cdf0e10cSrcweir theBadChars.BadChar = Mid(aName, I, 1) 1137cdf0e10cSrcweir theBadChars.Position = I 1138cdf0e10cSrcweir BadCharPosition = CStr(theBadChars.Position) 1139cdf0e10cSrcweir Select Case theBadChars.BadChar 1140cdf0e10cSrcweir Case "[", "]", "{", "}", ".", "!", "%", "$", "^", ".", "&", "(", ")", _ 1141cdf0e10cSrcweir "-", "=", "+", "~", "#", "@", "'", ";", "<", ">", ",", "|", "`" 1142cdf0e10cSrcweir newBadCharLine = ReplaceTopic2Tokens(RID_STR_EXCEL_ATTRIBUTE_BADCHARACTER, CR_BADCHAR, _ 1143cdf0e10cSrcweir theBadChars.BadChar, CR_BADCHARNUM, BadCharPosition) 1144cdf0e10cSrcweir invalidCharacterDetails = invalidCharacterDetails + newBadCharLine + ", " 1145cdf0e10cSrcweir Case Else 1146cdf0e10cSrcweir End Select 1147cdf0e10cSrcweir Next I 1148cdf0e10cSrcweir If Len(invalidCharacterDetails) > 0 Then 1149cdf0e10cSrcweir InvalidSheetNameCharacters = Left(invalidCharacterDetails, (Len(invalidCharacterDetails) - 2)) 1150cdf0e10cSrcweir Else 1151cdf0e10cSrcweir InvalidSheetNameCharacters = "" 1152cdf0e10cSrcweir End If 1153cdf0e10cSrcweir Exit Function 1154cdf0e10cSrcweir 1155cdf0e10cSrcweirHandleErrors: 1156cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1157cdf0e10cSrcweir 1158cdf0e10cSrcweirEnd Function 1159cdf0e10cSrcweir 1160cdf0e10cSrcweirSub Analyze_QueryTables(mySheet As Worksheet) 1161cdf0e10cSrcweir On Error GoTo HandleErrors 1162cdf0e10cSrcweir Dim currentFunctionName As String 1163cdf0e10cSrcweir currentFunctionName = "Analyze_QueryTables" 1164cdf0e10cSrcweir 1165cdf0e10cSrcweir Dim aTable As QueryTable 1166cdf0e10cSrcweir Dim myIssue As IssueInfo 1167cdf0e10cSrcweir Set myIssue = New IssueInfo 1168cdf0e10cSrcweir 1169cdf0e10cSrcweir For Each aTable In mySheet.QueryTables 1170cdf0e10cSrcweir If (aTable.QueryType = xlADORecordset) Or _ 1171cdf0e10cSrcweir (aTable.QueryType = xlDAORecordSet) Or _ 1172cdf0e10cSrcweir (aTable.QueryType = xlODBCQuery) Or _ 1173cdf0e10cSrcweir (aTable.QueryType = xlOLEDBQuery) Then 1174cdf0e10cSrcweir 1175cdf0e10cSrcweir With myIssue 1176cdf0e10cSrcweir .IssueID = CID_CHARTS_TABLES 1177cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES 1178cdf0e10cSrcweir .SubType = RID_RESXLS_COST_DB_Query 1179cdf0e10cSrcweir .Location = .CLocationSheet 1180cdf0e10cSrcweir .SubLocation = mySheet.name 1181cdf0e10cSrcweir 1182cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES 1183cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_DB_QUERY 1184cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 1185cdf0e10cSrcweir 1186cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DB_QUERY 1187cdf0e10cSrcweir .Values.Add aTable.Connection 1188cdf0e10cSrcweir 1189cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_DB_QUERY 1190cdf0e10cSrcweir 1191cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _ 1192cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1 1193cdf0e10cSrcweir End With 1194cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1195cdf0e10cSrcweir End If 1196cdf0e10cSrcweir Next aTable 1197cdf0e10cSrcweir 1198cdf0e10cSrcweirFinalExit: 1199cdf0e10cSrcweir Set myIssue = Nothing 1200cdf0e10cSrcweir Exit Sub 1201cdf0e10cSrcweir 1202cdf0e10cSrcweirHandleErrors: 1203cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1204cdf0e10cSrcweir Resume FinalExit 1205cdf0e10cSrcweirEnd Sub 1206cdf0e10cSrcweir 1207cdf0e10cSrcweirSub Analyze_WorkbookVersion(aWB As Workbook) 1208cdf0e10cSrcweir On Error GoTo HandleErrors 1209cdf0e10cSrcweir Dim currentFunctionName As String 1210cdf0e10cSrcweir currentFunctionName = "Analyze_WorkbookVersion" 1211cdf0e10cSrcweir Dim myIssue As IssueInfo 1212cdf0e10cSrcweir Set myIssue = New IssueInfo 1213cdf0e10cSrcweir Dim aProp As Variant 1214cdf0e10cSrcweir 1215cdf0e10cSrcweir If IsOldVersion(aWB.FileFormat) Then 1216cdf0e10cSrcweir With myIssue 1217cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1218cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1219cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_OLD_WORKBOOK_VERSION 1220cdf0e10cSrcweir .Location = .CLocationWorkBook 1221cdf0e10cSrcweir 1222cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1223cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_OLD_WORKBOOK_VERSION 1224cdf0e10cSrcweir .locationXML = .CXMLLocationWorkBook 1225cdf0e10cSrcweir 1226cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_WORKBOOK_VERSION 1227cdf0e10cSrcweir .Values.Add aWB.FileFormat 1228cdf0e10cSrcweir 1229cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_OLDWORKBOOKVERSION 1230cdf0e10cSrcweir 1231cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1232cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1233cdf0e10cSrcweir End With 1234cdf0e10cSrcweir Call DoPreparation(mAnalysis, myIssue, RID_STR_EXCEL_NOTE_OLD_OLDWORKBOOKVERSION_PREPARABLE, aProp, aWB) 1235cdf0e10cSrcweir 1236cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1237cdf0e10cSrcweir End If 1238cdf0e10cSrcweir 1239cdf0e10cSrcweirFinalExit: 1240cdf0e10cSrcweir Set myIssue = Nothing 1241cdf0e10cSrcweir Exit Sub 1242cdf0e10cSrcweir 1243cdf0e10cSrcweirHandleErrors: 1244cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1245cdf0e10cSrcweir Resume FinalExit 1246cdf0e10cSrcweirEnd Sub 1247cdf0e10cSrcweir 1248cdf0e10cSrcweirFunction getRange(myRange As Range) As String 1249cdf0e10cSrcweir On Error GoTo HandleErrors 1250cdf0e10cSrcweir Dim currentFunctionName As String 1251cdf0e10cSrcweir currentFunctionName = "getRange" 1252cdf0e10cSrcweir getRange = "" 1253cdf0e10cSrcweir 1254cdf0e10cSrcweir On Error Resume Next 1255cdf0e10cSrcweir getRange = myRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1) 1256cdf0e10cSrcweir 1257cdf0e10cSrcweirFinalExit: 1258cdf0e10cSrcweir Exit Function 1259cdf0e10cSrcweir 1260cdf0e10cSrcweirHandleErrors: 1261cdf0e10cSrcweir WriteDebug currentFunctionName & " : myRange.name " & myRange.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1262cdf0e10cSrcweir Resume FinalExit 1263cdf0e10cSrcweirEnd Function 1264cdf0e10cSrcweir 1265cdf0e10cSrcweirSub Analyze_CellInSheetIssues(mySheet As Worksheet) 1266cdf0e10cSrcweir On Error GoTo HandleErrors 1267cdf0e10cSrcweir Dim currentFunctionName As String 1268cdf0e10cSrcweir currentFunctionName = "Analyze_CellInSheetIssues" 1269cdf0e10cSrcweir Dim myCellRng As Range 1270cdf0e10cSrcweir 1271cdf0e10cSrcweir Set myCellRng = mySheet.UsedRange 1272cdf0e10cSrcweir Call CheckAllCellFormatting(myCellRng, mySheet.name) 1273cdf0e10cSrcweir Call CheckAllCellFunctions(myCellRng, mySheet.name) 1274cdf0e10cSrcweir 1275cdf0e10cSrcweirFinalExit: 1276cdf0e10cSrcweir Exit Sub 1277cdf0e10cSrcweirHandleErrors: 1278cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1279cdf0e10cSrcweirEnd Sub 1280cdf0e10cSrcweir 1281cdf0e10cSrcweirSub CheckAllCellFormatting(CurrRange As Range, myName As String) 1282cdf0e10cSrcweir On Error GoTo HandleErrors 1283cdf0e10cSrcweir Dim currentFunctionName As String 1284cdf0e10cSrcweir currentFunctionName = "CheckAllCellFormatting" 1285cdf0e10cSrcweir 1286cdf0e10cSrcweir Dim myCell As Range 1287cdf0e10cSrcweir Dim myCellAttri As CellAtrributes 1288cdf0e10cSrcweir Dim bCellIssue As Boolean 1289cdf0e10cSrcweir Dim bCellIssueAll As Boolean 1290cdf0e10cSrcweir Dim startTime As Single 1291cdf0e10cSrcweir 1292cdf0e10cSrcweir bCellIssue = False 1293cdf0e10cSrcweir bCellIssueAll = False 1294cdf0e10cSrcweir startTime = Timer 1295cdf0e10cSrcweir 1296cdf0e10cSrcweir For Each myCell In CurrRange 1297cdf0e10cSrcweir bCellIssue = CheckCellFormatting(myCell, myCellAttri) 1298cdf0e10cSrcweir bCellIssueAll = bCellIssueAll Or bCellIssue 1299cdf0e10cSrcweir If (Timer - gExcelMaxRangeProcessTime > startTime) Then 1300cdf0e10cSrcweir WriteDebug currentFunctionName & " : [" & myName & _ 1301cdf0e10cSrcweir "]Too much time needed, abortet cell formatting check." 1302cdf0e10cSrcweir Exit For 1303cdf0e10cSrcweir End If 1304cdf0e10cSrcweir Next 1305cdf0e10cSrcweir 1306cdf0e10cSrcweirFinalExit: 1307cdf0e10cSrcweir If bCellIssueAll Then 1308cdf0e10cSrcweir ReportCellFormattingIssue myName, myCellAttri 1309cdf0e10cSrcweir End If 1310cdf0e10cSrcweir 1311cdf0e10cSrcweir Exit Sub 1312cdf0e10cSrcweir 1313cdf0e10cSrcweirHandleErrors: 1314cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1315cdf0e10cSrcweirEnd Sub 1316cdf0e10cSrcweir 1317cdf0e10cSrcweirFunction CheckLineFormatIssue(myRange As Range, edge As XlBordersIndex) As Boolean 1318cdf0e10cSrcweir CheckLineFormatIssue = (myRange.Borders(edge).LineStyle <> xlContinuous) And _ 1319cdf0e10cSrcweir (myRange.Borders(edge).LineStyle <> xlDouble) And _ 1320cdf0e10cSrcweir (myRange.Borders(edge).LineStyle <> xlLineStyleNone) 1321cdf0e10cSrcweirEnd Function 1322cdf0e10cSrcweir 1323cdf0e10cSrcweirPrivate Function CheckCellFormatting(myCell As Range, myCellAttri As CellAtrributes) As Boolean 1324cdf0e10cSrcweir Dim currentFunctionName As String 1325cdf0e10cSrcweir currentFunctionName = "CheckCellFormatting" 1326cdf0e10cSrcweir 1327cdf0e10cSrcweir On Error GoTo HandleErrors 1328cdf0e10cSrcweir 1329cdf0e10cSrcweir Dim bCellLineFormatIssue As Boolean 1330cdf0e10cSrcweir 1331cdf0e10cSrcweir CheckCellFormatting = False 1332cdf0e10cSrcweir 1333cdf0e10cSrcweir bCellLineFormatIssue = CheckLineFormatIssue(myCell, xlEdgeBottom) Or _ 1334cdf0e10cSrcweir CheckLineFormatIssue(myCell, xlEdgeLeft) Or _ 1335cdf0e10cSrcweir CheckLineFormatIssue(myCell, xlEdgeRight) Or _ 1336cdf0e10cSrcweir CheckLineFormatIssue(myCell, xlEdgeTop) 1337cdf0e10cSrcweir 1338cdf0e10cSrcweir CheckCellFormatting = bCellLineFormatIssue Or _ 1339cdf0e10cSrcweir (myCell.Interior.Pattern <> xlPatternSolid And myCell.Interior.Pattern <> xlPatternNone) 1340cdf0e10cSrcweir 1341cdf0e10cSrcweir If Not CheckCellFormatting Then Exit Function 1342cdf0e10cSrcweir 1343cdf0e10cSrcweir If bCellLineFormatIssue Then 1344cdf0e10cSrcweir myCellAttri.LineStyle = myCellAttri.LineStyle + 1 1345cdf0e10cSrcweir End If 1346cdf0e10cSrcweir If (myCell.Interior.Pattern <> xlPatternSolid And myCell.Interior.Pattern <> xlPatternNone) Then 1347cdf0e10cSrcweir myCellAttri.FillPattern = myCellAttri.FillPattern + 1 1348cdf0e10cSrcweir End If 1349cdf0e10cSrcweir 1350cdf0e10cSrcweir Exit Function 1351cdf0e10cSrcweirHandleErrors: 1352cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1353cdf0e10cSrcweirEnd Function 1354cdf0e10cSrcweir 1355cdf0e10cSrcweirPrivate Sub ReportCellFormattingIssue(myName As String, myCellAttri As CellAtrributes) 1356cdf0e10cSrcweir Dim currentFunctionName As String 1357cdf0e10cSrcweir currentFunctionName = "ReportCellFormattingIssue" 1358cdf0e10cSrcweir 1359cdf0e10cSrcweir On Error GoTo HandleErrors 1360cdf0e10cSrcweir 1361cdf0e10cSrcweir Dim myIssue As IssueInfo 1362cdf0e10cSrcweir Set myIssue = New IssueInfo 1363cdf0e10cSrcweir 1364cdf0e10cSrcweir With myIssue 1365cdf0e10cSrcweir .IssueID = CID_FORMAT 1366cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_FORMAT 1367cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_ATTRIBUTES 1368cdf0e10cSrcweir .Location = .CLocationSheet 1369cdf0e10cSrcweir 1370cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_FORMAT 1371cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_ATTRIBUTES 1372cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 1373cdf0e10cSrcweir 1374cdf0e10cSrcweir .SubLocation = myName 1375cdf0e10cSrcweir '.Line = myCell.row 1376cdf0e10cSrcweir '.column = Chr(myCell.column + 65 - 1) 1377cdf0e10cSrcweir 1378cdf0e10cSrcweir Dim noteCount As Long 1379cdf0e10cSrcweir noteCount = 0 1380cdf0e10cSrcweir 1381cdf0e10cSrcweir If myCellAttri.LineStyle > 0 Then 1382cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_LINE_STYLE 1383cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_DASHED_DOT 1384cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_CELLS 1385cdf0e10cSrcweir .Values.Add myCellAttri.LineStyle 1386cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_ATTRIBUTES_3 1387cdf0e10cSrcweir noteCount = noteCount + 1 1388cdf0e10cSrcweir End If 1389cdf0e10cSrcweir If myCellAttri.FillPattern > 0 Then 1390cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FILL_PATTERN 1391cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_PATTERNED 1392cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_CELLS 1393cdf0e10cSrcweir .Values.Add myCellAttri.FillPattern 1394cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_ATTRIBUTES_4 1395cdf0e10cSrcweir noteCount = noteCount + 1 1396cdf0e10cSrcweir End If 1397cdf0e10cSrcweir 1398cdf0e10cSrcweir 1399cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FORMAT) = _ 1400cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FORMAT) + 1 1401cdf0e10cSrcweir End With 1402cdf0e10cSrcweir 1403cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1404cdf0e10cSrcweir 1405cdf0e10cSrcweirFinalExit: 1406cdf0e10cSrcweir Set myIssue = Nothing 1407cdf0e10cSrcweir Exit Sub 1408cdf0e10cSrcweirHandleErrors: 1409cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1410cdf0e10cSrcweirEnd Sub 1411cdf0e10cSrcweir 1412cdf0e10cSrcweirSub CheckAllCellFunctions(CurrRange As Range, myName As String) 1413cdf0e10cSrcweir On Error GoTo HandleErrors 1414cdf0e10cSrcweir Dim currentFunctionName As String 1415cdf0e10cSrcweir currentFunctionName = "CheckAllCellFunctions" 1416cdf0e10cSrcweir 1417cdf0e10cSrcweir Dim myCell As Range 1418cdf0e10cSrcweir Dim startTime As Single 1419cdf0e10cSrcweir 1420cdf0e10cSrcweir startTime = Timer 1421cdf0e10cSrcweir 1422cdf0e10cSrcweir For Each myCell In CurrRange 1423cdf0e10cSrcweir Call CheckCellFunction(myCell, myName) 1424cdf0e10cSrcweir If (Timer - gExcelMaxRangeProcessTime > startTime) Then 1425cdf0e10cSrcweir WriteDebug currentFunctionName & " : [" & myName & _ 1426cdf0e10cSrcweir "]Too much time needed, abortet cell functions check (xlCellTypeFormulas)." 1427cdf0e10cSrcweir Exit For 1428cdf0e10cSrcweir End If 1429cdf0e10cSrcweir Next 1430cdf0e10cSrcweir 1431cdf0e10cSrcweirFinalExit: 1432cdf0e10cSrcweir Exit Sub 1433cdf0e10cSrcweirHandleErrors: 1434cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1435cdf0e10cSrcweirEnd Sub 1436cdf0e10cSrcweir 1437cdf0e10cSrcweirSub CheckCellFunction(myCell As Range, myName As String) 1438cdf0e10cSrcweir Dim currentFunctionName As String 1439cdf0e10cSrcweir currentFunctionName = "CheckCellFunction" 1440cdf0e10cSrcweir 1441cdf0e10cSrcweir On Error GoTo HandleErrors 1442cdf0e10cSrcweir Dim bCellFunctionIssue As Boolean 1443cdf0e10cSrcweir Dim bCellINFOFunctionIssue As Boolean 1444cdf0e10cSrcweir Dim bCellERROR_TYPEFunctionIssue As Boolean 1445cdf0e10cSrcweir Dim bCellExternalFunctionIssue As Boolean 1446cdf0e10cSrcweir Dim bHasDateDifFunction As Boolean 1447cdf0e10cSrcweir Dim bHasPhoneticFunction As Boolean 1448cdf0e10cSrcweir Dim aFormularStr As String 1449cdf0e10cSrcweir 1450cdf0e10cSrcweir aFormularStr = myCell.FormulaR1C1 1451cdf0e10cSrcweir 1452cdf0e10cSrcweir If (aFormularStr = Null) Then Exit Sub 1453cdf0e10cSrcweir If (aFormularStr = "") Then Exit Sub 1454cdf0e10cSrcweir 1455cdf0e10cSrcweir bCellINFOFunctionIssue = (InStr(aFormularStr, "INFO(") <> 0) 1456cdf0e10cSrcweir bCellERROR_TYPEFunctionIssue = (InStr(aFormularStr, "ERROR.TYPE(") <> 0) 1457cdf0e10cSrcweir bCellExternalFunctionIssue = (InStr(aFormularStr, ".xls!") <> 0) 1458cdf0e10cSrcweir bHasDateDifFunction = (InStr(aFormularStr, "DATEDIF(") <> 0) 1459cdf0e10cSrcweir bHasPhoneticFunction = (InStr(aFormularStr, "PHONETIC(") <> 0) 1460cdf0e10cSrcweir 1461cdf0e10cSrcweir bCellFunctionIssue = bCellINFOFunctionIssue Or bCellERROR_TYPEFunctionIssue _ 1462cdf0e10cSrcweir Or bCellExternalFunctionIssue Or bHasDateDifFunction Or bHasPhoneticFunction 1463cdf0e10cSrcweir 1464cdf0e10cSrcweir If Not bCellFunctionIssue Then Exit Sub 1465cdf0e10cSrcweir 1466cdf0e10cSrcweir Dim myIssue As IssueInfo 1467cdf0e10cSrcweir Set myIssue = New IssueInfo 1468cdf0e10cSrcweir 1469cdf0e10cSrcweir With myIssue 1470cdf0e10cSrcweir .IssueID = CID_FUNCTIONS 1471cdf0e10cSrcweir .IssueType = RID_STR_EXCEL_ISSUE_FUNCTIONS 1472cdf0e10cSrcweir .Location = .CLocationSheet 1473cdf0e10cSrcweir 1474cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_FUNCTIONS 1475cdf0e10cSrcweir .locationXML = .CXMLLocationSheet 1476cdf0e10cSrcweir 1477cdf0e10cSrcweir .SubLocation = myName 1478cdf0e10cSrcweir .Line = myCell.row 1479cdf0e10cSrcweir .column = Chr(myCell.column + 65 - 1) 1480cdf0e10cSrcweir 1481cdf0e10cSrcweir Dim noteCount As Long 1482cdf0e10cSrcweir noteCount = 0 1483cdf0e10cSrcweir If bCellINFOFunctionIssue Then 1484cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_INFO 1485cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_INFO 1486cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING 1487cdf0e10cSrcweir .Values.Add myCell.FormulaR1C1 1488cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_1 1489cdf0e10cSrcweir noteCount = noteCount + 1 1490cdf0e10cSrcweir End If 1491cdf0e10cSrcweir If bCellERROR_TYPEFunctionIssue Then 1492cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_ERROR_TYPE 1493cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_ERROR_TYPE 1494cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING 1495cdf0e10cSrcweir .Values.Add myCell.FormulaR1C1 1496cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_2 1497cdf0e10cSrcweir noteCount = noteCount + 1 1498cdf0e10cSrcweir End If 1499cdf0e10cSrcweir If bCellExternalFunctionIssue Then 1500cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_EXTERNAL 1501cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_EXTERNAL 1502cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING 1503cdf0e10cSrcweir .Values.Add myCell.FormulaR1C1 1504cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_3 1505cdf0e10cSrcweir noteCount = noteCount + 1 1506cdf0e10cSrcweir End If 1507cdf0e10cSrcweir If bHasDateDifFunction Then 1508cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_DATEDIF 1509cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_DATEDIF 1510cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING 1511cdf0e10cSrcweir .Values.Add myCell.FormulaR1C1 1512cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_DATEDIF 1513cdf0e10cSrcweir noteCount = noteCount + 1 1514cdf0e10cSrcweir End If 1515cdf0e10cSrcweir If bHasPhoneticFunction Then 1516cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_PHONETIC 1517cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_PHONETIC 1518cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING 1519cdf0e10cSrcweir .Values.Add myCell.FormulaR1C1 1520cdf0e10cSrcweir AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_PHONETIC 1521cdf0e10cSrcweir noteCount = noteCount + 1 1522cdf0e10cSrcweir End If 1523cdf0e10cSrcweir 1524cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FUNCTIONS) = _ 1525cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_FUNCTIONS) + 1 1526cdf0e10cSrcweir End With 1527cdf0e10cSrcweir 1528cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1529cdf0e10cSrcweir 1530cdf0e10cSrcweirFinalExit: 1531cdf0e10cSrcweir Set myIssue = Nothing 1532cdf0e10cSrcweir Exit Sub 1533cdf0e10cSrcweirHandleErrors: 1534cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1535cdf0e10cSrcweirEnd Sub 1536cdf0e10cSrcweir 1537cdf0e10cSrcweirSub Analyze_Password_Protection(aWB As Workbook) 1538cdf0e10cSrcweir On Error GoTo HandleErrors 1539cdf0e10cSrcweir Dim currentFunctionName As String 1540cdf0e10cSrcweir currentFunctionName = "Analyze_Password_Protection" 1541cdf0e10cSrcweir Dim myIssue As IssueInfo 1542cdf0e10cSrcweir Set myIssue = New IssueInfo 1543cdf0e10cSrcweir 1544cdf0e10cSrcweir If aWB.HasPassword Or aWB.WriteReserved Then 1545cdf0e10cSrcweir With myIssue 1546cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1547cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1548cdf0e10cSrcweir .SubType = RID_STR_COMMON_SUBISSUE_PASSWORDS_PROTECTION 1549cdf0e10cSrcweir 1550cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1551cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_PASSWORD_PROTECTION 1552cdf0e10cSrcweir .locationXML = .CLocationWorkBook 1553cdf0e10cSrcweir 1554cdf0e10cSrcweir .Location = .CLocationWorkBook 1555cdf0e10cSrcweir 1556cdf0e10cSrcweir If aWB.HasPassword Then 1557cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PASSWORD_TO_OPEN 1558cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 1559cdf0e10cSrcweir End If 1560cdf0e10cSrcweir If aWB.WriteReserved Then 1561cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PASSWORD_TO_MODIFY 1562cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 1563cdf0e10cSrcweir End If 1564cdf0e10cSrcweir 1565cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1566cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1567cdf0e10cSrcweir End With 1568cdf0e10cSrcweir 1569cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1570cdf0e10cSrcweir End If 1571cdf0e10cSrcweir 1572cdf0e10cSrcweirFinalExit: 1573cdf0e10cSrcweir Set myIssue = Nothing 1574cdf0e10cSrcweir Exit Sub 1575cdf0e10cSrcweirHandleErrors: 1576cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1577cdf0e10cSrcweir Resume FinalExit 1578cdf0e10cSrcweirEnd Sub 1579cdf0e10cSrcweir 1580cdf0e10cSrcweirSub SetDocProperties(docAnalysis As DocumentAnalysis, wb As Workbook, fso As FileSystemObject) 1581cdf0e10cSrcweir On Error GoTo HandleErrors 1582cdf0e10cSrcweir Dim currentFunctionName As String 1583cdf0e10cSrcweir currentFunctionName = "SetProperties" 1584cdf0e10cSrcweir Dim f As File 1585cdf0e10cSrcweir Set f = fso.GetFile(docAnalysis.name) 1586cdf0e10cSrcweir 1587cdf0e10cSrcweir Const appPropertyAppName = 9 1588cdf0e10cSrcweir Const appPropertyLastAuthor = 7 1589cdf0e10cSrcweir Const appPropertyRevision = 8 1590cdf0e10cSrcweir Const appPropertyTemplate = 6 1591cdf0e10cSrcweir Const appPropertyTimeCreated = 11 1592cdf0e10cSrcweir Const appPropertyTimeLastSaved = 12 1593cdf0e10cSrcweir 1594cdf0e10cSrcweir On Error Resume Next 1595cdf0e10cSrcweir docAnalysis.PageCount = wb.Sheets.count 1596cdf0e10cSrcweir docAnalysis.Created = f.DateCreated 1597cdf0e10cSrcweir docAnalysis.Modified = f.DateLastModified 1598cdf0e10cSrcweir docAnalysis.Accessed = f.DateLastAccessed 1599cdf0e10cSrcweir docAnalysis.Printed = DateValue("01/01/1900") 1600cdf0e10cSrcweir On Error GoTo HandleErrors 1601cdf0e10cSrcweir 1602cdf0e10cSrcweir On Error Resume Next 'Some apps may not support all props 1603cdf0e10cSrcweir docAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version 1604cdf0e10cSrcweir 'docAnalysis.Application = wb.BuiltinDocumentProperties(appPropertyAppName) 1605cdf0e10cSrcweir 'If InStr(docAnalysis.Application, "Microsoft") = 1 Then 1606cdf0e10cSrcweir ' docAnalysis.Application = Mid(docAnalysis.Application, Len("Microsoft") + 2) 1607cdf0e10cSrcweir 'End If 1608cdf0e10cSrcweir 'If InStr(Len(docAnalysis.Application) - 2, docAnalysis.Application, ".") = 0 Then 1609cdf0e10cSrcweir ' docAnalysis.Application = docAnalysis.Application & " " & Application.Version 1610cdf0e10cSrcweir 'End If 1611cdf0e10cSrcweir 1612cdf0e10cSrcweir docAnalysis.SavedBy = _ 1613cdf0e10cSrcweir wb.BuiltinDocumentProperties(appPropertyLastAuthor) 1614cdf0e10cSrcweir docAnalysis.Revision = _ 1615cdf0e10cSrcweir val(wb.BuiltinDocumentProperties(appPropertyRevision)) 1616cdf0e10cSrcweir docAnalysis.Template = _ 1617cdf0e10cSrcweir fso.GetFileName(wb.BuiltinDocumentProperties(appPropertyTemplate)) 1618cdf0e10cSrcweir docAnalysis.Modified = _ 1619cdf0e10cSrcweir wb.BuiltinDocumentProperties(appPropertyTimeLastSaved) 1620cdf0e10cSrcweir 1621cdf0e10cSrcweirFinalExit: 1622cdf0e10cSrcweir Set f = Nothing 1623cdf0e10cSrcweir Exit Sub 1624cdf0e10cSrcweir 1625cdf0e10cSrcweirHandleErrors: 1626cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1627cdf0e10cSrcweir Resume FinalExit 1628cdf0e10cSrcweirEnd Sub 1629cdf0e10cSrcweir 1630cdf0e10cSrcweirSub Analyze_OLEEmbedded(wrkSheet As Worksheet) 1631cdf0e10cSrcweir On Error GoTo HandleErrors 1632cdf0e10cSrcweir Dim currentFunctionName As String 1633cdf0e10cSrcweir currentFunctionName = "Analyze_OLEEmbedded" 1634cdf0e10cSrcweir 1635cdf0e10cSrcweir ' Handle Shapes 1636cdf0e10cSrcweir Dim aShape As Shape 1637cdf0e10cSrcweir For Each aShape In wrkSheet.Shapes 1638cdf0e10cSrcweir Analyze_OLEEmbeddedSingleShape mAnalysis, aShape, wrkSheet.name 1639cdf0e10cSrcweir Analyze_Lines mAnalysis, aShape, wrkSheet.name 1640cdf0e10cSrcweir Analyze_Transparency mAnalysis, aShape, wrkSheet.name 1641cdf0e10cSrcweir Analyze_Gradients mAnalysis, aShape, wrkSheet.name 1642cdf0e10cSrcweir Next aShape 1643cdf0e10cSrcweir 1644cdf0e10cSrcweir Exit Sub 1645cdf0e10cSrcweir 1646cdf0e10cSrcweirHandleErrors: 1647cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1648cdf0e10cSrcweirEnd Sub 1649cdf0e10cSrcweir 1650cdf0e10cSrcweirSub Analyze_Workbook_Protection(aWB As Workbook) 1651cdf0e10cSrcweir On Error GoTo HandleErrors 1652cdf0e10cSrcweir Dim currentFunctionName As String 1653cdf0e10cSrcweir currentFunctionName = "Analyze_Workbook_Protection" 1654cdf0e10cSrcweir Dim myIssue As IssueInfo 1655cdf0e10cSrcweir Set myIssue = New IssueInfo 1656cdf0e10cSrcweir Dim bProtectSharing As Boolean 1657cdf0e10cSrcweir Dim bProtectStructure As Boolean 1658cdf0e10cSrcweir Dim bProtectWindows As Boolean 1659cdf0e10cSrcweir 1660cdf0e10cSrcweir bProtectSharing = False 1661cdf0e10cSrcweir bProtectStructure = False 1662cdf0e10cSrcweir bProtectWindows = False 1663cdf0e10cSrcweir 1664cdf0e10cSrcweir If Not WorkbookProtectTest(aWB, bProtectSharing, bProtectStructure, bProtectWindows) Then 1665cdf0e10cSrcweir GoTo FinalExit 1666cdf0e10cSrcweir End If 1667cdf0e10cSrcweir 1668cdf0e10cSrcweir Set myIssue = New IssueInfo 1669cdf0e10cSrcweir With myIssue 1670cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 1671cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 1672cdf0e10cSrcweir .SubType = RID_STR_EXCEL_SUBISSUE_WORKBOOK_PROTECTION 1673cdf0e10cSrcweir .Location = .CLocationWorkBook 1674cdf0e10cSrcweir 1675cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 1676cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_WORKBOOK_PROTECTION 1677cdf0e10cSrcweir .locationXML = .CXMLLocationWorkBook 1678cdf0e10cSrcweir 1679cdf0e10cSrcweir If bProtectSharing Then 1680cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_SHARING 1681cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 1682cdf0e10cSrcweir End If 1683cdf0e10cSrcweir If bProtectStructure Then 1684cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_STRUCTURE 1685cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 1686cdf0e10cSrcweir End If 1687cdf0e10cSrcweir If bProtectWindows Then 1688cdf0e10cSrcweir .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_WINDOWS 1689cdf0e10cSrcweir .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET 1690cdf0e10cSrcweir End If 1691cdf0e10cSrcweir 1692cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_PASSWORD_TO_OPEN 1693cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 1694cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 1695cdf0e10cSrcweir End With 1696cdf0e10cSrcweir 1697cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 1698cdf0e10cSrcweir 1699cdf0e10cSrcweirFinalExit: 1700cdf0e10cSrcweir Set myIssue = Nothing 1701cdf0e10cSrcweir Exit Sub 1702cdf0e10cSrcweir 1703cdf0e10cSrcweirHandleErrors: 1704cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1705cdf0e10cSrcweir Resume FinalExit 1706cdf0e10cSrcweir 1707cdf0e10cSrcweirEnd Sub 1708cdf0e10cSrcweir 1709cdf0e10cSrcweirPrivate Function WorkbookProtectTest(aWB As Workbook, bProtectSharing As Boolean, _ 1710cdf0e10cSrcweir bProtectStructure As Boolean, bProtectWindows As Boolean) As Boolean 1711cdf0e10cSrcweir On Error GoTo HandleErrors 1712cdf0e10cSrcweir Dim currentFunctionName As String 1713cdf0e10cSrcweir currentFunctionName = "WorkbookProtectTest" 1714cdf0e10cSrcweir 1715cdf0e10cSrcweir WorkbookProtectTest = False 1716cdf0e10cSrcweir 1717cdf0e10cSrcweir On Error Resume Next 'Simulate Try Catch 1718cdf0e10cSrcweir aWB.UnprotectSharing sharingPassword:=" " 1719cdf0e10cSrcweir If Err.Number = 1004 Then 1720cdf0e10cSrcweir bProtectSharing = True 1721cdf0e10cSrcweir ElseIf Err.Number <> 0 Then 1722cdf0e10cSrcweir Resume HandleErrors 1723cdf0e10cSrcweir End If 1724cdf0e10cSrcweir On Error GoTo HandleErrors 1725cdf0e10cSrcweir 1726cdf0e10cSrcweir On Error Resume Next 'Simulate Try Catch 1727cdf0e10cSrcweir aWB.Unprotect Password:="" 1728cdf0e10cSrcweir If Err.Number = 1004 Then 1729cdf0e10cSrcweir If aWB.ProtectStructure = True Then 1730cdf0e10cSrcweir bProtectStructure = True 1731cdf0e10cSrcweir End If 1732cdf0e10cSrcweir If aWB.ProtectWindows = True Then 1733cdf0e10cSrcweir bProtectWindows = True 1734cdf0e10cSrcweir End If 1735cdf0e10cSrcweir End If 1736cdf0e10cSrcweir 1737cdf0e10cSrcweir If bProtectSharing Or bProtectStructure Or bProtectWindows Then 1738cdf0e10cSrcweir WorkbookProtectTest = True 1739cdf0e10cSrcweir End If 1740cdf0e10cSrcweirFinalExit: 1741cdf0e10cSrcweir Exit Function 1742cdf0e10cSrcweir 1743cdf0e10cSrcweirHandleErrors: 1744cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1745cdf0e10cSrcweir Resume FinalExit 1746cdf0e10cSrcweir 1747cdf0e10cSrcweirEnd Function 1748cdf0e10cSrcweir 1749cdf0e10cSrcweirPrivate Sub Class_Initialize() 1750cdf0e10cSrcweir Set mAnalysis = New DocumentAnalysis 1751cdf0e10cSrcweirEnd Sub 1752cdf0e10cSrcweirPrivate Sub Class_Terminate() 1753cdf0e10cSrcweir Set mAnalysis = Nothing 1754cdf0e10cSrcweirEnd Sub 1755cdf0e10cSrcweir 1756cdf0e10cSrcweirPublic Property Get Results() As DocumentAnalysis 1757cdf0e10cSrcweir Set Results = mAnalysis 1758cdf0e10cSrcweirEnd Property 1759cdf0e10cSrcweirPrivate Function FormatIssueComplex(myChart As Chart, bDataTable As Boolean, bXAxes As Boolean) As Boolean 1760cdf0e10cSrcweir On Error GoTo HandleErrors 1761cdf0e10cSrcweir Dim currentFunctionName As String 1762cdf0e10cSrcweir currentFunctionName = "FormatIssueComplex" 1763cdf0e10cSrcweir 1764cdf0e10cSrcweir bXAxes = False 1765cdf0e10cSrcweir 1766cdf0e10cSrcweir If myChart.HasDataTable Then 1767cdf0e10cSrcweir bDataTable = True 1768cdf0e10cSrcweir End If 1769cdf0e10cSrcweir If Not (IsPie(myChart) Or myChart.ChartType = xlDoughnut Or myChart.ChartType = xlBubble3DEffect) Then 1770cdf0e10cSrcweir If myChart.HasAxis(1) Then 1771cdf0e10cSrcweir If myChart.Axes(1).CategoryType = xlTimeScale Or myChart.Axes(1).CategoryType = xlAutomaticScale Then 1772cdf0e10cSrcweir bXAxes = True 1773cdf0e10cSrcweir End If 1774cdf0e10cSrcweir End If 1775cdf0e10cSrcweir End If 1776cdf0e10cSrcweir If bDataTable Or bXAxes Then 1777cdf0e10cSrcweir FormatIssueComplex = True 1778cdf0e10cSrcweir End If 1779cdf0e10cSrcweir Exit Function 1780cdf0e10cSrcweirHandleErrors: 1781cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1782cdf0e10cSrcweirEnd Function 1783cdf0e10cSrcweir 1784cdf0e10cSrcweirPrivate Function IsAreaChart(myChart As Chart) As Boolean 1785cdf0e10cSrcweir 1786cdf0e10cSrcweir If (myChart.ChartType = xlArea Or myChart.ChartType = xl3DArea Or _ 1787cdf0e10cSrcweir myChart.ChartType = xlAreaStacked Or _ 1788cdf0e10cSrcweir myChart.ChartType = xl3DAreaStacked Or _ 1789cdf0e10cSrcweir myChart.ChartType = xlAreaStacked100 Or _ 1790cdf0e10cSrcweir myChart.ChartType = xl3DAreaStacked100) _ 1791cdf0e10cSrcweir Then 1792cdf0e10cSrcweir IsAreaChart = True 1793cdf0e10cSrcweir Else 1794cdf0e10cSrcweir IsAreaChart = False 1795cdf0e10cSrcweir End If 1796cdf0e10cSrcweir 1797cdf0e10cSrcweirEnd Function 1798cdf0e10cSrcweir 1799cdf0e10cSrcweirPrivate Function FormatissueMinor(myChart As Chart, bUnsupportedType As Boolean, bTrendline As Boolean, bDatalabelWithLegend As Boolean, bLegendPosition As Boolean, bTitleFont As Boolean, bPiechartDirection As Boolean, bAxisInterval As Boolean) As Boolean 1800cdf0e10cSrcweirOn Error GoTo HandleErrors 1801cdf0e10cSrcweirDim currentFunctionName As String 1802cdf0e10cSrcweircurrentFunctionName = "FormatissueMinor" 1803cdf0e10cSrcweir 1804cdf0e10cSrcweirDim ctype As Integer 1805cdf0e10cSrcweirDim fsize As Integer 1806cdf0e10cSrcweirDim se As Series 1807cdf0e10cSrcweirDim dl As DataLabel 1808cdf0e10cSrcweir 1809cdf0e10cSrcweir FormatissueMinor = False 1810cdf0e10cSrcweir ctype = myChart.ChartType 1811cdf0e10cSrcweir 1812cdf0e10cSrcweir If (ctype = xlBubble Or ctype = xlPieOfPie Or ctype = xl3DPieExploded _ 1813cdf0e10cSrcweir Or ctype = xlRadarFilled Or ctype = xlBubble3DEffect _ 1814cdf0e10cSrcweir Or ctype = xlRadarMarkers Or ctype = xlRadar Or ctype = xlBarOfPie _ 1815cdf0e10cSrcweir Or ctype = xlXYScatter Or ctype = xlXYScatterLines Or ctype = xlXYScatterLinesNoMarkers _ 1816cdf0e10cSrcweir Or ctype = xlXYScatterSmooth Or ctype = xlXYScatterSmoothNoMarkers _ 1817cdf0e10cSrcweir Or ctype = xlSurface Or ctype = xlSurfaceTopView Or ctype = xlSurfaceTopViewWireframe _ 1818cdf0e10cSrcweir Or ctype = xlSurfaceWireframe) Then 1819cdf0e10cSrcweir bUnsupportedType = True 1820cdf0e10cSrcweir End If 1821cdf0e10cSrcweir 1822cdf0e10cSrcweir For Each se In myChart.SeriesCollection 1823cdf0e10cSrcweir On Error Resume Next ' may not have trendlines property 1824cdf0e10cSrcweir If se.Trendlines.count <> 0 Then 1825cdf0e10cSrcweir If Err.Number = 0 Then 1826cdf0e10cSrcweir bTrendline = True 1827cdf0e10cSrcweir End If 1828cdf0e10cSrcweir End If 1829cdf0e10cSrcweir If se.HasDataLabels Then 1830cdf0e10cSrcweir If Err.Number = 0 Then 1831cdf0e10cSrcweir If (IsAreaChart(myChart)) Then 1832cdf0e10cSrcweir For Each dl In se.DataLabels 1833cdf0e10cSrcweir If dl.ShowLegendKey = True Then 1834cdf0e10cSrcweir bDatalabelWithLegend = True 1835cdf0e10cSrcweir Exit For 1836cdf0e10cSrcweir End If 1837cdf0e10cSrcweir Next dl 1838cdf0e10cSrcweir Else 1839cdf0e10cSrcweir Dim pt As Point 1840cdf0e10cSrcweir For Each pt In se.Points 1841cdf0e10cSrcweir If pt.HasDataLabel Then 1842cdf0e10cSrcweir If pt.DataLabel.ShowLegendKey Then 1843cdf0e10cSrcweir bDatalabelWithLegend = True 1844cdf0e10cSrcweir Exit For 1845cdf0e10cSrcweir End If 1846cdf0e10cSrcweir End If 1847cdf0e10cSrcweir Next pt 1848cdf0e10cSrcweir End If 1849cdf0e10cSrcweir End If 1850cdf0e10cSrcweir End If 1851cdf0e10cSrcweir On Error GoTo HandleErrors 1852cdf0e10cSrcweir If bTrendline And bDatalabelWithLegend Then 1853cdf0e10cSrcweir Exit For 1854cdf0e10cSrcweir End If 1855cdf0e10cSrcweir Next se 1856cdf0e10cSrcweir 1857cdf0e10cSrcweir If myChart.HasLegend Then 1858cdf0e10cSrcweir Dim legPos As Long 1859cdf0e10cSrcweir On Error Resume Next 'If legend moved accessing position will fail 1860cdf0e10cSrcweir legPos = myChart.Legend.Position 1861cdf0e10cSrcweir 1862cdf0e10cSrcweir If (Err.Number <> 0) Or (legPos <> xlLegendPositionRight) Then 1863cdf0e10cSrcweir bLegendPosition = True 1864cdf0e10cSrcweir End If 1865cdf0e10cSrcweir On Error GoTo HandleErrors 1866cdf0e10cSrcweir End If 1867cdf0e10cSrcweir 1868cdf0e10cSrcweir If IsPie(myChart) Then 1869cdf0e10cSrcweir bPiechartDirection = True 1870cdf0e10cSrcweir ElseIf myChart.ChartType <> xlDoughnut And myChart.ChartType <> xlBubble3DEffect Then 1871cdf0e10cSrcweir If myChart.HasAxis(xlValue, xlPrimary) Then 1872cdf0e10cSrcweir With myChart.Axes(xlValue, xlPrimary) 1873cdf0e10cSrcweir If .MajorUnitIsAuto And .MaximumScaleIsAuto And .MinimumScaleIsAuto And .MinorUnitIsAuto Then 1874cdf0e10cSrcweir bAxisInterval = True 1875cdf0e10cSrcweir End If 1876cdf0e10cSrcweir End With 1877cdf0e10cSrcweir End If 1878cdf0e10cSrcweir End If 1879cdf0e10cSrcweir 1880cdf0e10cSrcweir On Error Resume Next 'If title has mixed font size accessing Font.Size will fail - Title mixed font issue 1881cdf0e10cSrcweir If myChart.HasTitle Then 1882cdf0e10cSrcweir fsize = myChart.chartTitle.Font.Size 1883cdf0e10cSrcweir If Err.Number = FontError Then 1884cdf0e10cSrcweir bTitleFont = True 1885cdf0e10cSrcweir End If 1886cdf0e10cSrcweir End If 1887cdf0e10cSrcweir 1888cdf0e10cSrcweir On Error GoTo HandleErrors 1889cdf0e10cSrcweir If bUnsupportedType Or bTrendline Or bDatalabelWithLegend Or bLegendPosition Or bTitleFont Or bPiechartDirection Or bAxisInterval Then 1890cdf0e10cSrcweir FormatissueMinor = True 1891cdf0e10cSrcweir End If 1892cdf0e10cSrcweir 1893cdf0e10cSrcweirFinalExit: 1894cdf0e10cSrcweir 1895cdf0e10cSrcweir Set se = Nothing 1896cdf0e10cSrcweir Set dl = Nothing 1897cdf0e10cSrcweir Exit Function 1898cdf0e10cSrcweir 1899cdf0e10cSrcweirHandleErrors: 1900cdf0e10cSrcweir 1901cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 1902cdf0e10cSrcweir Resume FinalExit 1903cdf0e10cSrcweir 1904cdf0e10cSrcweirEnd Function 1905cdf0e10cSrcweir 1906cdf0e10cSrcweirPrivate Function SeriesIssue(myChart As Chart, bSeriesChartTypeChanged As Boolean, bDatasourceNotLinkedtoCell As Boolean, bDatasourceOnDifferentSheet As Boolean, bCategoryandValue As Boolean, bCLabelMorethanOneCell As Boolean, bOneColumnRow As Boolean) As Boolean 1907cdf0e10cSrcweirOn Error GoTo HandleErrors 1908cdf0e10cSrcweirDim currentFunctionName As String 1909cdf0e10cSrcweircurrentFunctionName = "SeriesIssue" 1910cdf0e10cSrcweirSeriesIssue = False 1911cdf0e10cSrcweir 1912cdf0e10cSrcweirDim Num As Integer 1913cdf0e10cSrcweirDim I As Integer 1914cdf0e10cSrcweirDim i2 As Integer 1915cdf0e10cSrcweirDim formula As String 1916cdf0e10cSrcweirDim p1 As Integer, p2 As Integer 1917cdf0e10cSrcweirDim b1 As Integer, b2 As Integer 1918cdf0e10cSrcweirDim comma1 As Integer, comma2 As Integer 1919cdf0e10cSrcweirDim starty As Integer 1920cdf0e10cSrcweirDim ctype As Integer 1921cdf0e10cSrcweirDim temp As Integer 1922cdf0e10cSrcweirDim myarray() As String 1923cdf0e10cSrcweirDim Values(3), sh 1924cdf0e10cSrcweirDim chartseries As Series 1925cdf0e10cSrcweirDim b As Boolean 1926cdf0e10cSrcweirDim bmorecolumns As Boolean 1927cdf0e10cSrcweirDim c As Boolean 1928cdf0e10cSrcweir 1929cdf0e10cSrcweirbmorecolumns = False 1930cdf0e10cSrcweirNum = myChart.SeriesCollection.count 1931cdf0e10cSrcweir 1932cdf0e10cSrcweirIf (Num = 0) Then Exit Function 1933cdf0e10cSrcweir 1934cdf0e10cSrcweirctype = myChart.SeriesCollection(1).ChartType 1935cdf0e10cSrcweirI = 0 1936cdf0e10cSrcweirsh = "" 1937cdf0e10cSrcweir 1938cdf0e10cSrcweirReDim Preserve myarray(Num, 3) 1939cdf0e10cSrcweir 1940cdf0e10cSrcweirIf IsPie(myChart) And Num > 1 Then 'if pie chart has more than one series,set series number to 1 1941cdf0e10cSrcweir bmorecolumns = True 1942cdf0e10cSrcweir Num = 1 1943cdf0e10cSrcweirEnd If 1944cdf0e10cSrcweirFor Each chartseries In myChart.SeriesCollection 1945cdf0e10cSrcweir On Error Resume Next 1946cdf0e10cSrcweir formula = chartseries.formula 1947cdf0e10cSrcweir If Err.Number <> 0 Then 1948cdf0e10cSrcweir GoTo FinalExit 1949cdf0e10cSrcweir End If 1950cdf0e10cSrcweir If Not bSeriesChartTypeChanged Then 'check if the chart type changed 1951cdf0e10cSrcweir temp = chartseries.ChartType 1952cdf0e10cSrcweir If temp <> ctype Then 1953cdf0e10cSrcweir bSeriesChartTypeChanged = True 1954cdf0e10cSrcweir End If 1955cdf0e10cSrcweir End If 1956cdf0e10cSrcweir 1957cdf0e10cSrcweir 'get each part of the formula, if it is a single range, set the value to the array 1958cdf0e10cSrcweir p1 = InStr(1, formula, "(") 1959cdf0e10cSrcweir comma1 = InStr(1, formula, ",") 1960cdf0e10cSrcweir Values(0) = Mid(formula, p1 + 1, comma1 - p1 - 1) 1961cdf0e10cSrcweir 1962cdf0e10cSrcweir If Mid(formula, comma1 + 1, 1) = "(" Then 1963cdf0e10cSrcweir' Multiple ranges 1964cdf0e10cSrcweir bDatasourceNotLinkedtoCell = True 1965cdf0e10cSrcweir GoTo FinalExit 1966cdf0e10cSrcweir Else 1967cdf0e10cSrcweir If Mid(formula, comma1 + 1, 1) = "{" Then 1968cdf0e10cSrcweir' Literal Array 1969cdf0e10cSrcweir bDatasourceNotLinkedtoCell = True 1970cdf0e10cSrcweir GoTo FinalExit 1971cdf0e10cSrcweir Else 1972cdf0e10cSrcweir' A single range 1973cdf0e10cSrcweir comma2 = InStr(comma1 + 1, formula, ",") 1974cdf0e10cSrcweir Values(1) = Mid(formula, comma1 + 1, comma2 - comma1 - 1) 1975cdf0e10cSrcweir starty = comma2 1976cdf0e10cSrcweir End If 1977cdf0e10cSrcweir End If 1978cdf0e10cSrcweir 1979cdf0e10cSrcweir If Mid(formula, starty + 1, 1) = "(" Then 1980cdf0e10cSrcweir' Multiple ranges 1981cdf0e10cSrcweir bDatasourceNotLinkedtoCell = True 1982cdf0e10cSrcweir GoTo FinalExit 1983cdf0e10cSrcweir Else 1984cdf0e10cSrcweir If Mid(formula, starty + 1, 1) = "{" Then 1985cdf0e10cSrcweir' Literal Array 1986cdf0e10cSrcweir bDatasourceNotLinkedtoCell = True 1987cdf0e10cSrcweir GoTo FinalExit 1988cdf0e10cSrcweir Else 1989cdf0e10cSrcweir' A single range 1990cdf0e10cSrcweir comma1 = starty 1991cdf0e10cSrcweir comma2 = InStr(comma1 + 1, formula, ",") 1992cdf0e10cSrcweir Values(2) = Mid(formula, comma1 + 1, comma2 - comma1 - 1) 1993cdf0e10cSrcweir End If 1994cdf0e10cSrcweir End If 1995cdf0e10cSrcweir 1996cdf0e10cSrcweir If SheetCheck(sh, Values) Then 'check if data from different sheet 1997cdf0e10cSrcweir bDatasourceOnDifferentSheet = True 1998cdf0e10cSrcweir GoTo FinalExit 1999cdf0e10cSrcweir End If 2000cdf0e10cSrcweir 2001cdf0e10cSrcweir For i2 = 0 To 2 'set data to myarray, if it is range, assign the range address, else null 2002cdf0e10cSrcweir If IsRange(Values(i2)) Then 2003cdf0e10cSrcweir myarray(I, i2) = Range(Values(i2)).Address 2004cdf0e10cSrcweir 'ElseIf (Not IsRange(values(i2))) And values(i2) <> "" Then 2005cdf0e10cSrcweir ' bDatasourceNotLinkedtoCell = True 2006cdf0e10cSrcweir ' myarray(i, i2) = "" 2007cdf0e10cSrcweir Else 2008cdf0e10cSrcweir bDatasourceNotLinkedtoCell = True 2009cdf0e10cSrcweir myarray(I, i2) = "" 2010cdf0e10cSrcweir End If 2011cdf0e10cSrcweir Next i2 2012cdf0e10cSrcweir 2013cdf0e10cSrcweir I = I + 1 2014cdf0e10cSrcweir If bmorecolumns Then 'if it is pie chart, exit 2015cdf0e10cSrcweir Exit For 2016cdf0e10cSrcweir End If 2017cdf0e10cSrcweirNext chartseries 2018cdf0e10cSrcweir 2019cdf0e10cSrcweir 2020cdf0e10cSrcweirc = DataCheck(myarray, Num, bCategoryandValue, bCLabelMorethanOneCell, bOneColumnRow) 'check data values and category of the chart 2021cdf0e10cSrcweir 2022cdf0e10cSrcweirFinalExit: 2023cdf0e10cSrcweirIf bSeriesChartTypeChanged Or bDatasourceNotLinkedtoCell Or bDatasourceOnDifferentSheet Or bCategoryandValue Or bCLabelMorethanOneCell Or bOneColumnRow Then 2024cdf0e10cSrcweir SeriesIssue = True 2025cdf0e10cSrcweirEnd If 2026cdf0e10cSrcweir 2027cdf0e10cSrcweirLast: 2028cdf0e10cSrcweir Set chartseries = Nothing 2029cdf0e10cSrcweir Exit Function 2030cdf0e10cSrcweir 2031cdf0e10cSrcweirHandleErrors: 2032cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2033cdf0e10cSrcweir Resume Last 2034cdf0e10cSrcweirEnd Function 2035cdf0e10cSrcweir 2036cdf0e10cSrcweirPrivate Function DataCheck(myarray() As String, Num As Integer, bCategoryandValue As Boolean, bCLabelMorethanOneCell As Boolean, bOneColumnRow As Boolean) 2037cdf0e10cSrcweirOn Error GoTo HandleErrors 2038cdf0e10cSrcweirDim currentFunctionName As String 2039cdf0e10cSrcweircurrentFunctionName = "DataCheck" 2040cdf0e10cSrcweir 2041cdf0e10cSrcweirDim s1() As String 2042cdf0e10cSrcweirDim v1() As String 2043cdf0e10cSrcweirDim v2() As String 2044cdf0e10cSrcweirDim c1() As String 2045cdf0e10cSrcweirDim c2() As String 2046cdf0e10cSrcweirDim bs1isrange As Boolean 2047cdf0e10cSrcweirDim bc1isrange As Boolean 2048cdf0e10cSrcweirDim bc2isrange As Boolean 2049cdf0e10cSrcweirDim j As Integer 2050cdf0e10cSrcweirDim I As Integer 2051cdf0e10cSrcweirDim btemp1 As Boolean 2052cdf0e10cSrcweirDim btemp2 As Boolean 2053cdf0e10cSrcweir 2054cdf0e10cSrcweir 2055cdf0e10cSrcweirbs1isrange = True 2056cdf0e10cSrcweirbc1isrange = True 2057cdf0e10cSrcweirbc2isrange = True 2058cdf0e10cSrcweir 2059cdf0e10cSrcweirIf myarray(0, 1) = "" Then 2060cdf0e10cSrcweir bs1isrange = False 2061cdf0e10cSrcweirElse 2062cdf0e10cSrcweir s1 = SplitRange(myarray(0, 1)) 2063cdf0e10cSrcweir If UBound(s1) < 4 Then 2064cdf0e10cSrcweir bOneColumnRow = True 2065cdf0e10cSrcweir GoTo FinalExit 2066cdf0e10cSrcweir End If 2067cdf0e10cSrcweir If (Asclong(s1(0)) <> Asclong(s1(2))) And (Asclong(s1(1)) <> Asclong(s1(3))) Then 2068cdf0e10cSrcweir bCLabelMorethanOneCell = True 2069cdf0e10cSrcweir GoTo FinalExit 2070cdf0e10cSrcweir End If 2071cdf0e10cSrcweir 2072cdf0e10cSrcweirEnd If 2073cdf0e10cSrcweir 2074cdf0e10cSrcweirIf myarray(0, 0) = "" Then 2075cdf0e10cSrcweir ReDim c1(2) 2076cdf0e10cSrcweir bc1isrange = False 2077cdf0e10cSrcweir c1(0) = "" 2078cdf0e10cSrcweir c1(1) = "" 2079cdf0e10cSrcweirElse 2080cdf0e10cSrcweir If InStr(1, myarray(0, 0), ":") <> 0 Then 2081cdf0e10cSrcweir bCLabelMorethanOneCell = True 2082cdf0e10cSrcweir GoTo FinalExit 2083cdf0e10cSrcweir End If 2084cdf0e10cSrcweir c1 = SplitRange(myarray(0, 0)) 2085cdf0e10cSrcweirEnd If 2086cdf0e10cSrcweirv1 = SplitRange(myarray(0, 2)) 2087cdf0e10cSrcweir 2088cdf0e10cSrcweirIf bs1isrange Then 2089cdf0e10cSrcweir btemp1 = s1(0) = s1(2) And s1(1) = v1(1) And s1(3) = v1(3) And Asclong(v1(0)) >= Asclong(s1(0)) + 1 'category beside first column 2090cdf0e10cSrcweir btemp2 = s1(1) = s1(3) And s1(0) = v1(0) And s1(2) = v1(2) And Asclong(v1(1)) >= Asclong(s1(1)) + 1 'category beside first row 2091cdf0e10cSrcweir If (Not btemp1) And (Not btemp2) Then 2092cdf0e10cSrcweir bCategoryandValue = True 2093cdf0e10cSrcweir GoTo FinalExit 2094cdf0e10cSrcweir End If 2095cdf0e10cSrcweirEnd If 2096cdf0e10cSrcweirIf bc1isrange Then 2097cdf0e10cSrcweir btemp1 = v1(0) = v1(2) And c1(0) = v1(0) And Asclong(c1(1)) <= Asclong(v1(1)) - 1 'data label beside row 2098cdf0e10cSrcweir btemp2 = v1(1) = v1(3) And c1(1) = v1(1) And Asclong(c1(0)) <= Asclong(v1(0)) - 1 'data label beside column 2099cdf0e10cSrcweir If (Not btemp1) And (Not btemp2) Then 2100cdf0e10cSrcweir bCategoryandValue = True 2101cdf0e10cSrcweir GoTo FinalExit 2102cdf0e10cSrcweir End If 2103cdf0e10cSrcweirEnd If 2104cdf0e10cSrcweirFor I = 1 To Num - 1 2105cdf0e10cSrcweir If myarray(I, 0) = "" Then 2106cdf0e10cSrcweir ReDim c2(2) 2107cdf0e10cSrcweir c2(0) = "" 2108cdf0e10cSrcweir c2(1) = "" 2109cdf0e10cSrcweir bc2isrange = False 2110cdf0e10cSrcweir Else 2111cdf0e10cSrcweir If InStr(1, myarray(0, 1), ":") = 0 Then 2112cdf0e10cSrcweir bCLabelMorethanOneCell = True 2113cdf0e10cSrcweir GoTo FinalExit 2114cdf0e10cSrcweir End If 2115cdf0e10cSrcweir c2 = SplitRange(myarray(I, 0)) 2116cdf0e10cSrcweir End If 2117cdf0e10cSrcweir v2 = SplitRange(myarray(I, 2)) 2118cdf0e10cSrcweir If bc2isrange Then 2119cdf0e10cSrcweir btemp1 = v1(0) = v1(2) And c2(0) = v2(0) And Asclong(c2(1)) <= Asclong(v2(1)) - 1 'data label beside row 2120cdf0e10cSrcweir btemp2 = v2(1) = v2(3) And c2(1) = v2(1) And Asclong(c2(0)) <= Asclong(v2(0)) - 1 'data label beside column 2121cdf0e10cSrcweir If (Not btemp1) And (Not btemp2) Then 2122cdf0e10cSrcweir bCategoryandValue = True 2123cdf0e10cSrcweir GoTo FinalExit 2124cdf0e10cSrcweir 'break 2125cdf0e10cSrcweir End If 2126cdf0e10cSrcweir End If 2127cdf0e10cSrcweir If bc1isrange And bc2isrange Then 2128cdf0e10cSrcweir 'series data beside last series data in column and data label beside last series data label 2129cdf0e10cSrcweir btemp1 = v2(0) = v2(2) And Asclong(c2(0)) = Asclong(c1(0)) + 1 And c2(1) = c1(1) And Asclong(v2(0)) = Asclong(v1(0)) + 1 And v1(1) = v2(1) And v1(3) = v2(3) 2130cdf0e10cSrcweir 'series data beside last series data in row and data label beside laast series data label 2131cdf0e10cSrcweir btemp2 = v2(1) = v2(3) And c1(0) = c2(0) And Asclong(c2(1)) = Asclong(c1(1)) + 1 And Asclong(v2(1)) = Asclong(v1(1)) + 1 And v1(0) = v2(0) And v1(2) = v2(2) 2132cdf0e10cSrcweir If (Not btemp1) And (Not btemp2) Then 2133cdf0e10cSrcweir bCategoryandValue = True 2134cdf0e10cSrcweir GoTo FinalExit 2135cdf0e10cSrcweir End If 2136cdf0e10cSrcweir ElseIf Not bc2isrange Then 2137cdf0e10cSrcweir btemp1 = v2(0) = v2(2) And Asclong(v2(0)) = Asclong(v1(0)) + 1 And v1(1) = v2(1) And v1(3) = v2(3) 'series data beside last series data in column 2138cdf0e10cSrcweir btemp2 = v2(1) = v2(3) And Asclong(v2(1)) = Asclong(v1(1)) + 1 And v1(0) = v2(0) And v1(2) = v2(2) 'series data beside last series data in row 2139cdf0e10cSrcweir If (Not btemp1) And (Not btemp2) Then 2140cdf0e10cSrcweir bCategoryandValue = True 2141cdf0e10cSrcweir GoTo FinalExit 2142cdf0e10cSrcweir End If 2143cdf0e10cSrcweir End If 2144cdf0e10cSrcweir For j = 0 To 1 2145cdf0e10cSrcweir c1(j) = c2(j) 2146cdf0e10cSrcweir Next j 2147cdf0e10cSrcweir For j = 0 To 3 2148cdf0e10cSrcweir v1(j) = v2(j) 2149cdf0e10cSrcweir Next j 2150cdf0e10cSrcweir bc1isrange = bc2isrange 2151cdf0e10cSrcweir bc2isrange = True 2152cdf0e10cSrcweir 2153cdf0e10cSrcweirNext I 2154cdf0e10cSrcweirFinalExit: 2155cdf0e10cSrcweirExit Function 2156cdf0e10cSrcweirHandleErrors: 2157cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2158cdf0e10cSrcweirEnd Function 2159cdf0e10cSrcweirPrivate Function SplitRange(a As String) As String() 2160cdf0e10cSrcweirOn Error GoTo HandleErrors 2161cdf0e10cSrcweirDim currentFunctionName As String 2162cdf0e10cSrcweircurrentFunctionName = "SplitRange" 2163cdf0e10cSrcweir 2164cdf0e10cSrcweirDim c1 As Integer, c2 As Integer, c3 As Integer 2165cdf0e10cSrcweirDim start As Integer 2166cdf0e10cSrcweirDim l As Integer 2167cdf0e10cSrcweirDim rearray() As String 2168cdf0e10cSrcweir 2169cdf0e10cSrcweirstart = 2 2170cdf0e10cSrcweirIf a <> "" Then 2171cdf0e10cSrcweir l = InStr(1, a, ":") 2172cdf0e10cSrcweir If l = 0 Then 2173cdf0e10cSrcweir ReDim rearray(2) 2174cdf0e10cSrcweir c1 = InStr(start, a, "$") 2175cdf0e10cSrcweir rearray(0) = Mid(a, start, c1 - start) 2176cdf0e10cSrcweir rearray(1) = Mid(a, c1 + 1, Len(a) - c1) 2177cdf0e10cSrcweir Else 2178cdf0e10cSrcweir ReDim rearray(4) 2179cdf0e10cSrcweir c1 = InStr(start, a, "$") 2180cdf0e10cSrcweir rearray(0) = Mid(a, start, c1 - start) 2181cdf0e10cSrcweir c2 = InStr(c1 + 1, a, "$") 2182cdf0e10cSrcweir rearray(1) = Mid(a, c1 + 1, c2 - c1 - 2) 2183cdf0e10cSrcweir c3 = InStr(c2 + 1, a, "$") 2184cdf0e10cSrcweir rearray(2) = Mid(a, c2 + 1, c3 - c2 - 1) 2185cdf0e10cSrcweir rearray(3) = Mid(a, c3 + 1, Len(a) - c3) 2186cdf0e10cSrcweir End If 2187cdf0e10cSrcweirElse 2188cdf0e10cSrcweir ReDim rearray(4) 2189cdf0e10cSrcweir rearray(0) = "" 2190cdf0e10cSrcweir rearray(1) = "" 2191cdf0e10cSrcweir rearray(2) = "" 2192cdf0e10cSrcweir rearray(3) = "" 2193cdf0e10cSrcweirEnd If 2194cdf0e10cSrcweirSplitRange = rearray 2195cdf0e10cSrcweir 2196cdf0e10cSrcweirExit Function 2197cdf0e10cSrcweirHandleErrors: 2198cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2199cdf0e10cSrcweirEnd Function 2200cdf0e10cSrcweirPrivate Function Asclong(s As String) As Integer 2201cdf0e10cSrcweirOn Error GoTo HandleErrors 2202cdf0e10cSrcweirDim currentFunctionName As String 2203cdf0e10cSrcweircurrentFunctionName = "Asclong" 2204cdf0e10cSrcweirAsclong = 0 2205cdf0e10cSrcweir 2206cdf0e10cSrcweirDim l As Integer 2207cdf0e10cSrcweirDim I As Integer 2208cdf0e10cSrcweirDim m As String 2209cdf0e10cSrcweir 2210cdf0e10cSrcweirl = Len(s) 2211cdf0e10cSrcweir 2212cdf0e10cSrcweirFor I = 1 To l 2213cdf0e10cSrcweir m = Mid(s, I, 1) 2214cdf0e10cSrcweir Asclong = Asclong + Asc(m) 2215cdf0e10cSrcweirNext I 2216cdf0e10cSrcweirExit Function 2217cdf0e10cSrcweir 2218cdf0e10cSrcweirHandleErrors: 2219cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2220cdf0e10cSrcweirEnd Function 2221cdf0e10cSrcweirPrivate Function SheetCheck(sh As Variant, Values() As Variant) As Boolean 2222cdf0e10cSrcweirOn Error GoTo HandleErrors 2223cdf0e10cSrcweirDim currentFunctionName As String 2224cdf0e10cSrcweircurrentFunctionName = "SheetCheck" 2225cdf0e10cSrcweirSheetCheck = False 2226cdf0e10cSrcweir 2227cdf0e10cSrcweirDim c1 As Integer 2228cdf0e10cSrcweirDim I As Integer 2229cdf0e10cSrcweir 2230cdf0e10cSrcweirDim temp 2231cdf0e10cSrcweir 2232cdf0e10cSrcweirFor I = 0 To 2 2233cdf0e10cSrcweir If IsRange(Values(I)) Then 2234cdf0e10cSrcweir c1 = InStr(1, Values(I), "!") 2235cdf0e10cSrcweir If sh = "" Then 2236cdf0e10cSrcweir sh = Mid(Values(I), 1, c1 - 1) 2237cdf0e10cSrcweir temp = Mid(Values(I), 1, c1 - 1) 2238cdf0e10cSrcweir Else 2239cdf0e10cSrcweir temp = Mid(Values(I), 1, c1 - 1) 2240cdf0e10cSrcweir End If 2241cdf0e10cSrcweir If temp <> sh Then 2242cdf0e10cSrcweir SheetCheck = True 2243cdf0e10cSrcweir Exit Function 2244cdf0e10cSrcweir End If 2245cdf0e10cSrcweir End If 2246cdf0e10cSrcweirNext I 2247cdf0e10cSrcweirExit Function 2248cdf0e10cSrcweir 2249cdf0e10cSrcweirHandleErrors: 2250cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2251cdf0e10cSrcweirEnd Function 2252cdf0e10cSrcweirPrivate Function IsRange(Ref) As Boolean 2253cdf0e10cSrcweirOn Error GoTo HandleErrors 2254cdf0e10cSrcweirDim currentFunctionName As String 2255cdf0e10cSrcweircurrentFunctionName = "IsRange" 2256cdf0e10cSrcweir 2257cdf0e10cSrcweirDim x As Range 2258cdf0e10cSrcweir 2259cdf0e10cSrcweirOn Error Resume Next 2260cdf0e10cSrcweirSet x = Range(Ref) 2261cdf0e10cSrcweirIf Err = 0 Then 2262cdf0e10cSrcweir IsRange = True 2263cdf0e10cSrcweirElse 2264cdf0e10cSrcweir IsRange = False 2265cdf0e10cSrcweirEnd If 2266cdf0e10cSrcweirFinalExit: 2267cdf0e10cSrcweir Set x = Nothing 2268cdf0e10cSrcweir Exit Function 2269cdf0e10cSrcweir 2270cdf0e10cSrcweirHandleErrors: 2271cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2272cdf0e10cSrcweir Resume FinalExit 2273cdf0e10cSrcweirEnd Function 2274cdf0e10cSrcweirPrivate Function IsPie(myChart As Chart) As Boolean 2275cdf0e10cSrcweirOn Error GoTo HandleErrors 2276cdf0e10cSrcweirDim currentFunctionName As String 2277cdf0e10cSrcweircurrentFunctionName = "IsPie" 2278cdf0e10cSrcweirDim ctype As Integer 2279cdf0e10cSrcweir IsPie = False 2280cdf0e10cSrcweir 2281cdf0e10cSrcweir ctype = myChart.ChartType 2282cdf0e10cSrcweir If (ctype = xlPie) Or _ 2283cdf0e10cSrcweir (ctype = xlPieExploded) Or _ 2284cdf0e10cSrcweir (ctype = xlPieOfPie) Or _ 2285cdf0e10cSrcweir (ctype = xl3DPie) Or _ 2286cdf0e10cSrcweir (ctype = xl3DPieExploded) Then 2287cdf0e10cSrcweir 2288cdf0e10cSrcweir IsPie = True 2289cdf0e10cSrcweir End If 2290cdf0e10cSrcweir Exit Function 2291cdf0e10cSrcweir 2292cdf0e10cSrcweirHandleErrors: 2293cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 2294cdf0e10cSrcweirEnd Function 2295cdf0e10cSrcweir 2296cdf0e10cSrcweirPrivate Function IsOldVersion(aFormat As XlFileFormat) As Boolean 2297cdf0e10cSrcweir Dim theResult As Boolean 2298cdf0e10cSrcweir Dim currentFunctionName As String 2299cdf0e10cSrcweir currentFunctionName = "IsOldVersion" 2300cdf0e10cSrcweir 2301cdf0e10cSrcweir Select Case aFormat 2302cdf0e10cSrcweir Case xlExcel2, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7 2303cdf0e10cSrcweir theResult = True 2304cdf0e10cSrcweir Case xlExcel9795, xlWorkbookNormal 2305cdf0e10cSrcweir theResult = False 2306cdf0e10cSrcweir Case Else 2307cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": The version of this spreadsheet is not recognised" 2308cdf0e10cSrcweir End Select 2309cdf0e10cSrcweir 2310cdf0e10cSrcweir IsOldVersion = theResult 2311cdf0e10cSrcweirEnd Function 2312cdf0e10cSrcweir 2313cdf0e10cSrcweir 2314