diff options
Diffstat (limited to 'migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls')
| -rw-r--r-- | migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls | 2319 |
1 files changed, 2319 insertions, 0 deletions
diff --git a/migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls b/migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls new file mode 100644 index 000000000000..1378417344cc --- /dev/null +++ b/migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls @@ -0,0 +1,2319 @@ +VERSION 1.0 CLASS
+BEGIN
+ MultiUse = -1 'True
+END
+Attribute VB_Name = "MigrationAnalyser"
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+'/*************************************************************************
+' *
+' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +' +' Copyright 2000, 2010 Oracle and/or its affiliates. +' +' OpenOffice.org - a multi-platform office productivity suite +' +' This file is part of OpenOffice.org. +' +' OpenOffice.org is free software: you can redistribute it and/or modify +' it under the terms of the GNU Lesser General Public License version 3 +' only, as published by the Free Software Foundation. +' +' OpenOffice.org is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU Lesser General Public License version 3 for more details +' (a copy is included in the LICENSE file that accompanied this code). +' +' You should have received a copy of the GNU Lesser General Public License +' version 3 along with OpenOffice.org. If not, see +' <http://www.openoffice.org/license.html> +' for a copy of the LGPLv3 License. +' +' ************************************************************************/
+Option Explicit
+
+Const CWORKBOOK_SHEETS_LIMIT = 256
+
+'Class variables
+Private Enum HFIssueType
+ hfInline
+ hfShape
+ hfFrame
+End Enum
+
+Private Enum HFIssueLocation
+ hfHeader
+ hfFooter
+End Enum
+
+Private Type CellAtrributes
+ LineStyle As Integer
+ FillPattern As Integer
+End Type
+
+Private Type BadSheetNameChar
+ BadChar As String
+ Position As Integer
+End Type
+
+Private mAnalysis As DocumentAnalysis
+Private mFileName As String
+
+Const RID_STR_EXCEL_SUBISSUE_ERROR_TYPE = "ERROR.TYPE"
+Const RID_STR_EXCEL_SUBISSUE_INFO = "INFO"
+Const RID_STR_EXCEL_SUBISSUE_DATEDIF = "DATEDIF"
+Const RID_STR_EXCEL_SUBISSUE_PHONETIC = "PHONETIC"
+Const FontError = 94
+Const CR_BADCHAR = "<TOKEN1>"
+Const CR_BADCHARNUM = "<TOKEN2>"
+Const DATA_SOURCE_EXCEL = 0
+Const DATA_SOURCE_EXTERNAL = 1
+Const DATA_SOURCE_MULTIPLE = 2
+Const DATA_SOURCE_EXTERNAL_FILE = 3
+Const C_MAX_CELL_RANGE_COUNT = 10000
+
+Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
+
+'***ADDING-ISSUE: Use Following Skeleton as Guideline for Adding Issue
+' For complete list of all RID_STR_... for Issues (IssueType), SubIssues (SubType) and Attributes refer to:
+' excel_res.bas and common_res.bas
+'
+' For complete list of all CID_... for Issue Categories(IssueID) and
+' CSTR_... for XML Issues (IssueTypeXML) and XML SubIssues (SubTypeXML) refer to:
+' ApplicationSpecific.bas and CommonMigrationAnalyser.bas
+'
+' You should not have to add any new Issue Categories or matching IssueTypes, only new SubIssues
+Sub Analyze_SKELETON()
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SKELETON"
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ With myIssue
+ .IssueID = CID_VBA_MACROS 'Issue Category
+ .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 'Issue String
+ .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 'SubIssue String
+ .Location = .CLocationDocument 'Location string
+
+ .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 'Non localised XML Issue String
+ .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 'Non localised XML SubIssue String
+ .locationXML = .CXMLLocationDocument 'Non localised XML location
+
+ .SubLocation = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
+ .Line = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
+ .column = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND
+
+ ' Add as many Attribute Value pairs as needed
+ ' Note: following must always be true - Attributes.Count = Values.Count
+ .Attributes.Add "AAA"
+ .Values.Add "foobar"
+
+ ' Use AddIssueDetailsNote to add notes to the Issue Details if required
+ ' Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _
+ ' Optional preStr As String = RID_STR_COMMON_NOTE_PRE)
+ ' Where preStr is prepended to the output, with "Note" as the default
+ AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_NOTE_DOCUMENT_PROPERTIES_LOST
+
+ mAnalysis.IssuesCountArray(CID_VBA_MACROS) = _
+ mAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1
+ End With
+
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub DoAnalyse(fileName As String, userFormTypesDict As Scripting.Dictionary, _
+ startDir As String, storeToDir As String, fso As FileSystemObject)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "DoAnalyse"
+ 'Dim secAutomation As MsoAutomationSecurity
+ 'secAutomation = Application.AutomationSecurity
+
+ mAnalysis.name = fileName
+ Dim aWB As Workbook
+ mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES
+
+ 'Make Excel run as non interactively as possible
+ Application.EnableEvents = False
+ Application.DisplayAlerts = False
+ Application.Interactive = False
+ Application.AskToUpdateLinks = False
+ Application.EnableAnimations = False
+ Application.EnableSound = False
+
+ 'Only supported in Office XP and above
+ 'Application.AutomationSecurity = msoAutomationSecurityForceDisable
+ 'mFileName = fso.GetFileName(fileName)
+ 'WriteToLog "TmpDebug1", mFileName
+
+ Dim myPassword As String
+
+ myPassword = GetDefaultPassword
+
+ If myPassword = "" Then
+ myPassword = "xoxoxoxoxo"
+ End If
+
+ Set aWB = Workbooks.Open(fileName:=fileName, _
+ Password:=myPassword, _
+ WriteResPassword:=myPassword, _
+ UpdateLinks:=0)
+
+ 'Application.AutomationSecurity = secAutomation
+
+ 'Do Analysis
+ Analyze_Password_Protection aWB
+ Analyze_Workbook_Protection aWB
+
+ 'Set Doc Properties
+ SetDocProperties mAnalysis, aWB, fso
+
+ Analyze_SheetLimits aWB
+ Analyze_SheetDisplay aWB
+ Analyze_SheetIssues aWB
+ Analyze_SheetCharts aWB
+ Analyze_WorkbookVersion aWB
+ Analyze_Macros mAnalysis, userFormTypesDict, aWB
+
+ ' Doc Preparation only
+ ' Save document with any fixed issues under <storeToDir>\prepared\<source doc name>
+ If mAnalysis.PreparableIssuesCount > 0 And CheckDoPrepare Then
+ Dim preparedFullPath As String
+ preparedFullPath = GetPreparedFullPath(mAnalysis.name, startDir, storeToDir, fso)
+ If preparedFullPath <> "" Then
+ If fso.FileExists(preparedFullPath) Then
+ fso.DeleteFile preparedFullPath, True
+ End If
+ If fso.FolderExists(fso.GetParentFolderName(preparedFullPath)) Then
+ If IsOldVersion(aWB.FileFormat) Then
+ aWB.SaveAs fileName:=preparedFullPath, FileFormat:=xlExcel9795
+ Else
+ aWB.SaveAs preparedFullPath
+ End If
+ End If
+ End If
+ End If
+
+FinalExit:
+ If Not aWB Is Nothing Then
+ aWB.Close (False)
+ End If
+
+ Set aWB = Nothing
+
+ Application.EnableEvents = True
+ Application.DisplayAlerts = True
+ Application.Interactive = True
+ Application.AskToUpdateLinks = True
+ Application.EnableAnimations = True
+ Application.EnableSound = True
+
+ 'Debug - Call Sleep(5000)
+ Exit Sub
+
+HandleErrors:
+ ' MsgBox currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ ' Handle Password error on Doc Open, Modify and Cancel
+ If Err.Number = 1004 Then
+ WriteDebug currentFunctionName & " : " & fileName & ": " & _
+ "User entered Invalid Document Password - " & Err.Number & " " & Err.Description & " " & Err.Source
+ HandleProtectedDocInvalidPassword mAnalysis, _
+ "User entered Invalid Document Password, further analysis not possible", fso
+ Resume FinalExit
+ End If
+ mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN
+ WriteDebug currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_SheetCharts(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SheetCharts"
+
+ Dim myChartSheet As Chart
+
+ For Each myChartSheet In aWB.Charts
+ SetChartIssueMinor myChartSheet, myChartSheet.name, False
+ SetChartIssueComplex myChartSheet, myChartSheet.name
+ Next myChartSheet
+
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_EmbeddedCharts(mySheet As Worksheet)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_EmbeddedCharts"
+ Dim BorderIssue As Boolean
+
+ Dim index As Integer
+ BorderIssue = False
+ Dim chartcount As Integer
+ Dim myChart As Chart
+
+ chartcount = mySheet.ChartObjects.count
+
+ For index = 1 To chartcount
+ BorderIssue = False
+ With mySheet.ChartObjects(index)
+ If .Border.LineStyle <> xlLineStyleNone Then
+ BorderIssue = True
+ End If
+ SetChartIssueMinor .Chart, mySheet.name, BorderIssue
+ 'If Not ((.ChartType = xlSurface) _
+ ' And (.ChartType = xlSurfaceTopViewWireframe) _
+ ' And (.ChartType = xlSurfaceTopView)) Then
+ SetChartIssueComplex .Chart, mySheet.name
+ 'End If
+ End With
+ Next index
+
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Private Function getType(o As Variant) As Integer
+ If (VarType(o) = vbString) Then
+ Dim aDataSource As String
+ aDataSource = o
+ getType = DATA_SOURCE_EXCEL
+ If (Len(aDataSource) > 0) Then
+ Dim nBackslashPos As Long
+ nBackslashPos = InStr(Trim(aDataSource), "\")
+ If (nBackslashPos > 0 And nBackslashPos < 4) Then
+ getType = DATA_SOURCE_EXTERNAL_FILE
+ End If
+ End If
+ ElseIf (IsArray(o)) Then
+ If (hasSecondDimension(o)) Then
+ getType = DATA_SOURCE_MULTIPLE
+ Else
+ getType = DATA_SOURCE_EXTERNAL
+ End If
+ End If
+End Function
+
+Private Function hasSecondDimension(o2 As Variant) As Boolean
+ On Error GoTo njet
+ Dim temp As Integer
+ temp = UBound(o2, 2)
+ hasSecondDimension = True
+ Exit Function
+njet:
+ hasSecondDimension = False
+End Function
+
+Private Sub Analyze_PivotTable(myIssue As IssueInfo, myPivotTable As PivotTable)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyse_PivotTable"
+
+ Dim aPivotField As PivotField
+ Dim aNoteCount As Long
+ Dim bManualSort As Boolean
+ Dim bCalculatedValues As Boolean
+ Dim aSorting As XlSortOrder
+ Dim nCount As Integer
+ Dim nDataSource As Integer
+
+ bManualSort = False
+ bCalculatedValues = False
+
+ For Each aPivotField In myPivotTable.PivotFields
+ aSorting = xlAscending
+
+ On Error Resume Next 'some fields don't have any property at all
+ aSorting = aPivotField.AutoSortOrder
+ On Error GoTo HandleErrors
+
+ If (aSorting = xlManual) Then
+ bManualSort = True
+ End If
+
+ nCount = 0
+
+ On Error Resume Next 'some fields don't have any property at all
+ nCount = aPivotField.CalculatedItems.count
+ On Error GoTo HandleErrors
+
+ If (nCount > 0) Then
+ bCalculatedValues = True
+ End If
+ Next
+
+ nCount = 0
+
+ On Error Resume Next 'some fields don't have any property at all
+ nCount = myPivotTable.CalculatedFields.count
+ On Error GoTo HandleErrors
+
+ If (nCount > 0) Then
+ bCalculatedValues = True
+ End If
+
+ nDataSource = getType(myPivotTable.SourceData)
+
+ aNoteCount = 0
+
+ If (bManualSort) Then
+ AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_ManSort_Comment
+ aNoteCount = aNoteCount + 1
+ End If
+
+ If (nDataSource = DATA_SOURCE_EXTERNAL) Then
+ AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_ExternData_Comment
+ aNoteCount = aNoteCount + 1
+ ElseIf (nDataSource = DATA_SOURCE_MULTIPLE) Then
+ AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_MultConsRanges_Comment
+ aNoteCount = aNoteCount + 1
+ ElseIf (nDataSource = DATA_SOURCE_EXTERNAL_FILE) Then
+ Dim noteString As String
+ noteString = RID_RESXLT_COST_PIVOT_ExternData_Comment & "[" & _
+ myPivotTable.SourceData & "]"
+ AddIssueDetailsNote myIssue, aNoteCount, noteString
+ aNoteCount = aNoteCount + 1
+ End If
+
+ If (bCalculatedValues) Then
+ AddIssueDetailsNote myIssue, aNoteCount, RID_RESXLT_COST_PIVOT_CalcVal_Comment
+ aNoteCount = aNoteCount + 1
+ End If
+
+FinalExit:
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Private Sub SetChartIssueComplex(myChart As Chart, myName As String)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "SetChartIssueComplex"
+
+ Dim myIssue As IssueInfo
+ Dim bSeriesChartTypeChanged As Boolean
+ Dim bDatasourceNotLinkedtoCell As Boolean
+ Dim bDatasourceOnDifferentSheet As Boolean
+ Dim bCategoryandValue As Boolean
+ Dim bCLabelMorethanOneCell As Boolean
+ Dim bOneColumnRow As Boolean
+ Dim bDataTable As Boolean
+ Dim bXAxes As Boolean
+ Dim bseries As Boolean
+ Dim bformat As Boolean
+ Dim bpivot As Boolean
+
+
+ Set myIssue = New IssueInfo
+ bSeriesChartTypeChanged = False
+ bDatasourceNotLinkedtoCell = False
+ bDatasourceOnDifferentSheet = False
+ bCategoryandValue = False
+ bCLabelMorethanOneCell = False
+ bOneColumnRow = False
+ bDataTable = False
+ bXAxes = False
+
+ bformat = FormatIssueComplex(myChart, bDataTable, bXAxes)
+ bseries = SeriesIssue(myChart, bSeriesChartTypeChanged, bDatasourceNotLinkedtoCell, bDatasourceOnDifferentSheet, bCategoryandValue, bCLabelMorethanOneCell, bOneColumnRow)
+ bpivot = Not (myChart.PivotLayout Is Nothing)
+
+ If (Not (bseries Or bformat Or bpivot)) Then
+ GoTo FinalExit
+ ElseIf bpivot Then
+ With myIssue
+ .IssueID = CID_CHARTS_TABLES
+ .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES
+ .SubType = RID_STR_EXCEL_SUBISSUE_PIVOT
+ .Location = .CLocationSheet
+ .SubLocation = myName
+
+ .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES
+ .SubTypeXML = CSTR_SUBISSUE_CHART_PIVOT
+ .locationXML = .CXMLLocationSheet
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_TABLE_NAME
+ .Values.Add myChart.PivotLayout.PivotTable.name
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_VISIBLE
+ .Values.Add myChart.HasPivotFields
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_NUM
+ .Values.Add myChart.PivotLayout.PivotTable.PivotFields.count
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE
+ .Values.Add getChartTypeAsString(myChart.ChartType)
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME
+ .Values.Add myChart.name
+ End With
+
+ AddIssueDetailsNote myIssue, 0, RID_RESXLT_COST_PIVOT_PivotChart_Comment
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1
+ mAnalysis.Issues.Add myIssue
+
+ GoTo FinalExit
+ Else
+ With myIssue
+ Dim NoteIndex As Long
+ NoteIndex = 0
+
+ .IssueID = CID_CHARTS_TABLES
+ .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES
+ .SubType = RID_STR_EXCEL_SUBISSUE_CHART_COMPLEX
+ .Location = .CLocationSheet
+ .SubLocation = myName
+
+ .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES
+ .SubTypeXML = CSTR_SUBISSUE_CHART_COMPLEX
+ .locationXML = .CXMLLocationSheet
+
+ If bDataTable Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATATABLE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATATABLE
+ NoteIndex = NoteIndex + 1
+ End If
+ If bXAxes Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_XAXISCATEGORY
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_TIMESCALE
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_XAXISCATEGORY
+ NoteIndex = NoteIndex + 1
+ End If
+ If bSeriesChartTypeChanged Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_SERIESCHARTTYPE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_CHANGED
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_SERIESCHARTTYPE
+ NoteIndex = NoteIndex + 1
+ End If
+ If bDatasourceNotLinkedtoCell Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCENOTLINKEDTOCELL
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATASOURCENOTLINKEDTOCELL
+ NoteIndex = NoteIndex + 1
+ End If
+ If bDatasourceOnDifferentSheet Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_DATASOURCEONDIFFERENTSHEET
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATASOURCEONDIFFERENTSHEET
+ NoteIndex = NoteIndex + 1
+ End If
+ If bCategoryandValue Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYANDDATA
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SEPARATE
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_CATEGORYANDDATA
+ NoteIndex = NoteIndex + 1
+ End If
+ If bCLabelMorethanOneCell Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYLABEL
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_CATEGORYLABELMORETHANONECELL
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_CATEGORYLABELMORETHANONECELL
+ NoteIndex = NoteIndex + 1
+ End If
+ If bOneColumnRow Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_COLUMNBAR
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_ONECOLUMNROW
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_COLUMNBAR
+ NoteIndex = NoteIndex + 1
+ End If
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE
+ .Values.Add getChartTypeAsString(myChart.ChartType)
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME
+ .Values.Add myChart.name
+ End With
+
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1
+ mAnalysis.Issues.Add myIssue
+ End If
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Private Sub SetChartIssueMinor(myChart As Chart, myName As String, BorderIssue As Boolean)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "SetChartIssueMinor"
+
+ Dim myIssue As IssueInfo
+ Dim bUnsupportedType As Boolean
+ Dim bTrendline As Boolean
+ Dim bDatalabelWithLegend As Boolean
+ Dim bLegendPosition As Boolean
+ Dim bTitleFont As Boolean
+ Dim bPiechartDirection As Boolean
+ Dim bAxisInterval As Boolean
+
+
+ Set myIssue = New IssueInfo
+ bUnsupportedType = False
+ bTrendline = False
+ bDatalabelWithLegend = False
+ bLegendPosition = False
+ bTitleFont = False
+ bPiechartDirection = False
+ bAxisInterval = False
+
+
+ If (Not FormatissueMinor(myChart, bUnsupportedType, bTrendline, bDatalabelWithLegend, bLegendPosition, bTitleFont, bPiechartDirection, bAxisInterval)) And (Not BorderIssue) Then
+ GoTo FinalExit
+ Else
+ With myIssue
+ Dim NoteIndex As Long
+ NoteIndex = 0
+
+ .IssueID = CID_CHARTS_TABLES
+ .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES
+
+ .SubType = RID_STR_EXCEL_SUBISSUE_CHART_MINOR
+ .Location = .CLocationSheet
+ .SubLocation = myName
+
+ .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES
+ .SubTypeXML = CSTR_SUBISSUE_CHART_PIVOT
+ .locationXML = .CXMLLocationSheet
+
+ If bUnsupportedType Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_UNSUPPORTEDTYPE
+ .Values.Add getChartTypeAsString(myChart.ChartType)
+ ' bubble chart
+ If (myChart.ChartType = xlBubble Or myChart.ChartType = xlBubble3DEffect) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Bubble_Comment
+ ' bar of pie and pie of pie chart
+ ElseIf (myChart.ChartType = xlPieOfPie Or myChart.ChartType = xlBarOfPie) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_BarOfPie_Comment
+ ' Scatter chart
+ ElseIf (myChart.ChartType = xlXYScatter Or myChart.ChartType = xlXYScatterLines _
+ Or myChart.ChartType = xlXYScatterLinesNoMarkers _
+ Or myChart.ChartType = xlXYScatterSmooth _
+ Or myChart.ChartType = xlXYScatterSmoothNoMarkers) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Scattered_Comment
+ ' radar chart
+ ElseIf (myChart.ChartType = xlRadarMarkers Or myChart.ChartType = xlRadar) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Radar_Comment
+ ' radar filled chart
+ ElseIf (myChart.ChartType = xlRadarFilled) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_FilledRadar_Comment
+ ' surface chart
+ ElseIf (myChart.ChartType = xlSurface Or myChart.ChartType = xlSurfaceTopView _
+ Or myChart.ChartType = xlSurfaceTopViewWireframe _
+ Or myChart.ChartType = xlSurfaceWireframe) Then
+ AddIssueDetailsNote myIssue, NoteIndex, RID_RESXLT_COST_CHART_Surface_Comment
+ Else
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_UNSUPPORTEDTYPE1
+ NoteIndex = NoteIndex + 1
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_UNSUPPORTEDTYPE2
+ End If
+ NoteIndex = NoteIndex + 1
+ End If
+ If bTrendline Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TRENDLINE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_TRENDLINE
+ NoteIndex = NoteIndex + 1
+ End If
+ If bDatalabelWithLegend Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DATALABELWITHLEGEND
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_DATALABELWITHLEGEND
+ NoteIndex = NoteIndex + 1
+ End If
+ If bLegendPosition Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_LEGENDPOSITION
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_NOTRIGHT
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_LEGENDPOSITION
+ NoteIndex = NoteIndex + 1
+ End If
+ If bTitleFont Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TITLEFONT
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_DIFFERENT
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_TITLEFONT
+ NoteIndex = NoteIndex + 1
+ End If
+ If bPiechartDirection Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SLICES_IN_DIFFERENT_DIRECTION
+ End If
+ If BorderIssue Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_BORDER
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_BORDER
+ NoteIndex = NoteIndex + 1
+ End If
+ If bAxisInterval Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_AXISINTERVAL
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_AUTO
+ AddIssueDetailsNote myIssue, NoteIndex, RID_STR_EXCEL_NOTE_AXISINTERVAL
+ NoteIndex = NoteIndex + 1
+ End If
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_CHARTNAME
+ .Values.Add myChart.name
+ End With
+
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1
+ mAnalysis.Issues.Add myIssue
+ End If
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub SetChartIssue(myChart As Chart, myName As String, strSubType As String, _
+ strXMLSubType As String)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "SetChartIssue"
+ Dim myIssue As IssueInfo
+ Dim bUnsupportedPosition As Boolean
+
+ Set myIssue = New IssueInfo
+
+ ' Common Settings
+ With myIssue
+ .IssueID = CID_CHARTS_TABLES
+ .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES
+ .SubType = strSubType
+ .Location = .CLocationSheet
+ .SubLocation = myName
+
+ .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES
+ .SubTypeXML = strXMLSubType
+ .locationXML = .CXMLLocationSheet
+
+
+ If myChart.HasTitle Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TITLE
+ .Values.Add myChart.chartTitle.Text
+ End If
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_TYPE
+ .Values.Add myChart.ChartType 'TBD - getChartTypeAsString() convert to String
+
+ 'Pie Chart
+ If (myChart.ChartType = xlPie) Or _
+ (myChart.ChartType = xlPieExploded) Or _
+ (myChart.ChartType = xlPieOfPie) Or _
+ (myChart.ChartType = xl3DPie) Or _
+ (myChart.ChartType = xl3DPieExploded) Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SLICES_IN_DIFFERENT_DIRECTION
+ End If
+
+ If Not myChart.PivotLayout Is Nothing Then
+ 'Pivot Chart
+ .SubType = RID_STR_EXCEL_SUBISSUE_PIVOT & " " & strSubType
+
+ 'Pivot Chart details
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_TABLE_NAME
+ .Values.Add myChart.PivotLayout.PivotTable.name
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_VISIBLE
+ .Values.Add myChart.HasPivotFields
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PIVOT_FIELDS_NUM
+ .Values.Add myChart.PivotLayout.PivotTable.PivotFields.count
+ End If
+ End With
+
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Function getLineStyleAsString(myLineStyle As XlLineStyle) As String
+
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "getLineStyleAsString"
+
+ Dim strVal As String
+
+ Select Case myLineStyle
+ Case xlContinuous
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_CONTINUOUS
+ Case xlDash
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DASH
+ Case xlDashDot
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DASHDOT
+ Case xlDot
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DOT
+ Case xlDouble
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_DOUBLE
+ Case xlSlantDashDot
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_SLANTDASHDOT
+ Case xlLineStyleNone
+ strVal = RID_STR_EXCEL_ENUMERATION_LINE_STYLE_LINESTYLENONE
+ Case Else
+ strVal = RID_STR_EXCEL_ENUMERATION_UNKNOWN
+ End Select
+
+
+ getLineStyleAsString = strVal
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+
+Function getChartTypeAsString(myChartType As XlChartType) As String
+ '*********************************************************
+ '**** Localisation: ON HOLD ******************************
+ '*********************************************************
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "getChartTypeAsString"
+
+ Dim strVal As String
+
+ Select Case myChartType
+ Case xl3DArea
+ strVal = "3DArea"
+ Case xl3DAreaStacked
+ strVal = "3DAreaStacked"
+ Case xl3DAreaStacked100
+ strVal = "3DAreaStacked100"
+ Case xl3DBarClustered
+ strVal = "3DBarClustered"
+ Case xl3DBarStacked
+ strVal = "xl3DBarStacked"
+ Case xl3DBarStacked100
+ strVal = "xl3DBarStacked100"
+ Case xl3DColumn
+ strVal = "3DColumn"
+ Case xl3DColumnClustered
+ strVal = "xl3DColumnClustered"
+ Case xl3DColumnStacked
+ strVal = "xl3DColumnStacked"
+ Case xl3DColumnStacked100
+ strVal = "xl3DColumnStacked100"
+ Case xl3DLine
+ strVal = "3DLine"
+ Case xl3DPie
+ strVal = "3DPie"
+ Case xl3DPieExploded
+ strVal = "3DPieExploded"
+ Case xlArea
+ strVal = "Area"
+ Case xlAreaStacked
+ strVal = "AreaStacked"
+ Case xlAreaStacked100
+ strVal = "AreaStacked100"
+ Case xlBarClustered
+ strVal = "BarClustered"
+ Case xlBarOfPie
+ strVal = "BarOfPie"
+ Case xlBarStacked
+ strVal = "BarStacked"
+ Case xlBarStacked100
+ strVal = "BarStacked100"
+ Case xlBubble
+ strVal = "Bubble"
+ Case xlBubble3DEffect
+ strVal = "Bubble3DEffect"
+ Case xlColumnClustered
+ strVal = "ColumnClustered"
+ Case xlColumnStacked
+ strVal = "ColumnStacked"
+ Case xlColumnStacked100
+ strVal = "ColumnStacked100"
+ Case xlConeBarClustered
+ strVal = "ConeBarClustered"
+ Case xlConeBarStacked
+ strVal = "ConeBarStacked"
+ Case xlConeBarStacked100
+ strVal = "ConeBarStacked100"
+ Case xlConeCol
+ strVal = "ConeCol"
+ Case xlConeColClustered
+ strVal = "ConeColClustered"
+ Case xlConeColStacked
+ strVal = "ConeColStacked"
+ Case xlConeColStacked100
+ strVal = "ConeColStacked100"
+ Case xlCylinderBarClustered
+ strVal = "CylinderBarClustered"
+ Case xlCylinderBarStacked
+ strVal = "CylinderBarStacked"
+ Case xlCylinderBarStacked100
+ strVal = "CylinderBarStacked100"
+ Case xlCylinderCol
+ strVal = "CylinderCol"
+ Case xlCylinderColClustered
+ strVal = "CylinderColClustered"
+ Case xlCylinderColStacked
+ strVal = "CylinderColStacked"
+ Case xlCylinderColStacked100
+ strVal = "CylinderColStacked100"
+ Case xlDoughnut
+ strVal = "Doughnut"
+ Case xlLine
+ strVal = "Line"
+ Case xlLineMarkers
+ strVal = "LineMarkers"
+ Case xlLineMarkersStacked
+ strVal = "LineMarkersStacked"
+ Case xlLineMarkersStacked100
+ strVal = "LineMarkersStacked100"
+ Case xlLineStacked
+ strVal = "LineStacked"
+ Case xlLineStacked100
+ strVal = "LineStacked100"
+ Case xlPie
+ strVal = "Pie"
+ Case xlPieExploded
+ strVal = "PieExploded"
+ Case xlPieOfPie
+ strVal = "PieOfPie"
+ Case xlPyramidBarClustered
+ strVal = "PyramidBarClustered"
+ Case xlPyramidBarStacked
+ strVal = "PyramidBarStacked"
+ Case xlPyramidBarStacked100
+ strVal = "PyramidBarStacked100"
+ Case xlPyramidCol
+ strVal = "PyramidCol"
+ Case xlPyramidColClustered
+ strVal = "PyramidColClustered"
+ Case xlPyramidColStacked
+ strVal = "PyramidColStacked"
+ Case xlPyramidColStacked100
+ strVal = "PyramidColStacked100"
+ Case xlRadar
+ strVal = "Radar"
+ Case xlRadarFilled
+ strVal = "RadarFilled"
+ Case xlRadarMarkers
+ strVal = "RadarMarkers"
+ Case xlStockHLC
+ strVal = "StockHLC"
+ Case xlStockOHLC
+ strVal = "StockOHLC"
+ Case xlStockVHLC
+ strVal = "StockVHLC"
+ Case xlStockVOHLC
+ strVal = "StockVOHLC"
+ Case xlSurface
+ strVal = "Surface"
+ Case xlSurfaceTopView
+ strVal = "SurfaceTopView"
+ Case xlSurfaceTopViewWireframe
+ strVal = "SurfaceTopViewWireframe"
+ Case xlSurfaceWireframe
+ strVal = "SurfaceWireframe"
+ Case xlXYScatter
+ strVal = "XYScatter"
+ Case xlXYScatterLines
+ strVal = "XYScatterLines"
+ Case xlXYScatterLinesNoMarkers
+ strVal = "XYScatterLinesNoMarkers"
+ Case xlXYScatterSmooth
+ strVal = "XYScatterSmooth"
+ Case xlXYScatterSmoothNoMarkers
+ strVal = "XYScatterSmoothNoMarkers"
+ Case Else
+ strVal = RID_STR_EXCEL_ENUMERATION_UNKNOWN
+ End Select
+
+ getChartTypeAsString = strVal
+
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+
+Sub HandleZoomIssue(currentSheet)
+ Dim myIssue As IssueInfo
+ Dim currentFunctionName As String
+ currentFunctionName = "HandleZoomIssue"
+
+ On Error GoTo HandleErrors
+
+ Set myIssue = New IssueInfo
+ With myIssue
+ .IssueID = CID_FORMAT
+ .IssueType = RID_STR_EXCEL_ISSUE_FORMAT
+ .SubType = RID_STR_EXCEL_SUBISSUE_ZOOM
+ .Location = .CLocationSheet
+ .SubLocation = currentSheet.name
+
+ .IssueTypeXML = CSTR_ISSUE_FORMAT
+ .SubTypeXML = CSTR_SUBISSUE_ZOOM
+ .locationXML = .CXMLLocationSheet
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_ZOOM
+ End With
+
+ mAnalysis.IssuesCountArray(CID_FORMAT) = _
+ mAnalysis.IssuesCountArray(CID_FORMAT) + 1
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_SheetDisplay(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SheetDisplay"
+
+ If aWB.Sheets.count = 1 Then Exit Sub
+
+ Dim lastZoomVal As Integer
+ Dim bInitZoom As Boolean
+ Dim bZoomChanged As Boolean
+ Dim ws As Object
+
+ bInitZoom = True
+ bZoomChanged = False
+
+ For Each ws In aWB.Sheets
+ ws.Activate
+
+ On Error GoTo HandleErrors
+
+ If bInitZoom Then
+ lastZoomVal = ActiveWindow.Zoom
+ bInitZoom = False
+ ElseIf Not bZoomChanged Then
+ If ActiveWindow.Zoom <> lastZoomVal Then
+ bZoomChanged = True
+ HandleZoomIssue ws
+ End If
+ End If
+ If bZoomChanged Then Exit For
+ Next ws
+
+FinalExit:
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_SheetLimits(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SheetLimits"
+ Dim myIssue As IssueInfo
+
+ If aWB.Sheets.count < CWORKBOOK_SHEETS_LIMIT + 1 Then Exit Sub
+
+ Set myIssue = New IssueInfo
+ With myIssue
+ .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+ .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+ .SubType = RID_STR_EXCEL_SUBISSUE_MAX_SHEETS_EXCEEDED
+ .Location = .CLocationWorkBook
+ .SubLocation = aWB.name
+
+ .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+ .SubTypeXML = CSTR_SUBISSUE_MAX_SHEETS_EXCEEDED
+ .locationXML = .CXMLLocationWorkBook
+
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_SHEETS
+ .Values.Add aWB.Sheets.count
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_SHEET_LIMITS_1 & CWORKBOOK_SHEETS_LIMIT
+ AddIssueDetailsNote myIssue, 1, RID_STR_EXCEL_NOTE_SHEET_LIMITS_2 & CWORKBOOK_SHEETS_LIMIT
+ End With
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+ mAnalysis.Issues.Add myIssue
+ Set myIssue = Nothing
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_SheetIssues(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SheetIssues"
+
+ Dim myWrkSheet As Worksheet
+
+ For Each myWrkSheet In aWB.Worksheets
+ Analyze_OLEEmbedded myWrkSheet
+ Analyze_CellInSheetIssues myWrkSheet
+ Analyze_EmbeddedCharts myWrkSheet
+ Analyze_SheetName myWrkSheet
+ Analyze_QueryTables myWrkSheet
+ Next myWrkSheet
+
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_SheetName(mySheet As Worksheet)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_SheetName"
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ Dim invalidCharacters As String
+ invalidCharacters = InvalidSheetNameCharacters(mySheet.name)
+ If Len(invalidCharacters) <> 0 Then
+ With myIssue
+ .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+ .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+ .SubType = RID_STR_EXCEL_SUBISSUE_INVALID_WORKSHEET_NAME
+ .Location = .CLocationSheet
+ .SubLocation = mySheet.name
+
+ .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+ .SubTypeXML = CSTR_SUBISSUE_INVALID_WORKSHEET_NAME
+ .locationXML = .CXMLLocationSheet
+
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_INVALIDCHARACTER
+ .Values.Add invalidCharacters
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_INVALIDWORKSHEETNAME
+
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+ End With
+ mAnalysis.Issues.Add myIssue
+ End If
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Function InvalidSheetNameCharacters(aName As String) As String
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "InvalidSheetNameCharacters"
+
+ Dim I As Integer
+ Dim NameCount As Integer
+ Dim newBadCharLine As String
+ Dim invalidCharacterDetails As String
+ Dim BadCharPosition As String
+ Dim theBadChars As BadSheetNameChar
+ NameCount = Len(aName)
+ invalidCharacterDetails = ""
+ For I = 1 To NameCount
+ theBadChars.BadChar = Mid(aName, I, 1)
+ theBadChars.Position = I
+ BadCharPosition = CStr(theBadChars.Position)
+ Select Case theBadChars.BadChar
+ Case "[", "]", "{", "}", ".", "!", "%", "$", "^", ".", "&", "(", ")", _
+ "-", "=", "+", "~", "#", "@", "'", ";", "<", ">", ",", "|", "`"
+ newBadCharLine = ReplaceTopic2Tokens(RID_STR_EXCEL_ATTRIBUTE_BADCHARACTER, CR_BADCHAR, _
+ theBadChars.BadChar, CR_BADCHARNUM, BadCharPosition)
+ invalidCharacterDetails = invalidCharacterDetails + newBadCharLine + ", "
+ Case Else
+ End Select
+ Next I
+ If Len(invalidCharacterDetails) > 0 Then
+ InvalidSheetNameCharacters = Left(invalidCharacterDetails, (Len(invalidCharacterDetails) - 2))
+ Else
+ InvalidSheetNameCharacters = ""
+ End If
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+
+End Function
+
+Sub Analyze_QueryTables(mySheet As Worksheet)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_QueryTables"
+
+ Dim aTable As QueryTable
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ For Each aTable In mySheet.QueryTables
+ If (aTable.QueryType = xlADORecordset) Or _
+ (aTable.QueryType = xlDAORecordSet) Or _
+ (aTable.QueryType = xlODBCQuery) Or _
+ (aTable.QueryType = xlOLEDBQuery) Then
+
+ With myIssue
+ .IssueID = CID_CHARTS_TABLES
+ .IssueType = RID_STR_EXCEL_ISSUE_CHARTS_AND_TABLES
+ .SubType = RID_RESXLS_COST_DB_Query
+ .Location = .CLocationSheet
+ .SubLocation = mySheet.name
+
+ .IssueTypeXML = CSTR_ISSUE_CHARTS_TABLES
+ .SubTypeXML = CSTR_SUBISSUE_DB_QUERY
+ .locationXML = .CXMLLocationSheet
+
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_DB_QUERY
+ .Values.Add aTable.Connection
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_DB_QUERY
+
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) = _
+ mAnalysis.IssuesCountArray(CID_CHARTS_TABLES) + 1
+ End With
+ mAnalysis.Issues.Add myIssue
+ End If
+ Next aTable
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_WorkbookVersion(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_WorkbookVersion"
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+ Dim aProp As Variant
+
+ If IsOldVersion(aWB.FileFormat) Then
+ With myIssue
+ .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+ .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+ .SubType = RID_STR_EXCEL_SUBISSUE_OLD_WORKBOOK_VERSION
+ .Location = .CLocationWorkBook
+
+ .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+ .SubTypeXML = CSTR_SUBISSUE_OLD_WORKBOOK_VERSION
+ .locationXML = .CXMLLocationWorkBook
+
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_WORKBOOK_VERSION
+ .Values.Add aWB.FileFormat
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_OLDWORKBOOKVERSION
+
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+ End With
+ Call DoPreparation(mAnalysis, myIssue, RID_STR_EXCEL_NOTE_OLD_OLDWORKBOOKVERSION_PREPARABLE, aProp, aWB)
+
+ mAnalysis.Issues.Add myIssue
+ End If
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Function getRange(myRange As Range) As String
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "getRange"
+ getRange = ""
+
+ On Error Resume Next
+ getRange = myRange.Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1)
+
+FinalExit:
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : myRange.name " & myRange.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Function
+
+Sub Analyze_CellInSheetIssues(mySheet As Worksheet)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_CellInSheetIssues"
+ Dim myCellRng As Range
+
+ Set myCellRng = mySheet.UsedRange
+ Call CheckAllCellFormatting(myCellRng, mySheet.name)
+ Call CheckAllCellFunctions(myCellRng, mySheet.name)
+
+FinalExit:
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub CheckAllCellFormatting(CurrRange As Range, myName As String)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "CheckAllCellFormatting"
+
+ Dim myCell As Range
+ Dim myCellAttri As CellAtrributes
+ Dim bCellIssue As Boolean
+ Dim bCellIssueAll As Boolean
+ Dim startTime As Single
+
+ bCellIssue = False
+ bCellIssueAll = False
+ startTime = Timer
+
+ For Each myCell In CurrRange
+ bCellIssue = CheckCellFormatting(myCell, myCellAttri)
+ bCellIssueAll = bCellIssueAll Or bCellIssue
+ If (Timer - gExcelMaxRangeProcessTime > startTime) Then
+ WriteDebug currentFunctionName & " : [" & myName & _
+ "]Too much time needed, abortet cell formatting check."
+ Exit For
+ End If
+ Next
+
+FinalExit:
+ If bCellIssueAll Then
+ ReportCellFormattingIssue myName, myCellAttri
+ End If
+
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Function CheckLineFormatIssue(myRange As Range, edge As XlBordersIndex) As Boolean
+ CheckLineFormatIssue = (myRange.Borders(edge).LineStyle <> xlContinuous) And _
+ (myRange.Borders(edge).LineStyle <> xlDouble) And _
+ (myRange.Borders(edge).LineStyle <> xlLineStyleNone)
+End Function
+
+Private Function CheckCellFormatting(myCell As Range, myCellAttri As CellAtrributes) As Boolean
+ Dim currentFunctionName As String
+ currentFunctionName = "CheckCellFormatting"
+
+ On Error GoTo HandleErrors
+
+ Dim bCellLineFormatIssue As Boolean
+
+ CheckCellFormatting = False
+
+ bCellLineFormatIssue = CheckLineFormatIssue(myCell, xlEdgeBottom) Or _
+ CheckLineFormatIssue(myCell, xlEdgeLeft) Or _
+ CheckLineFormatIssue(myCell, xlEdgeRight) Or _
+ CheckLineFormatIssue(myCell, xlEdgeTop)
+
+ CheckCellFormatting = bCellLineFormatIssue Or _
+ (myCell.Interior.Pattern <> xlPatternSolid And myCell.Interior.Pattern <> xlPatternNone)
+
+ If Not CheckCellFormatting Then Exit Function
+
+ If bCellLineFormatIssue Then
+ myCellAttri.LineStyle = myCellAttri.LineStyle + 1
+ End If
+ If (myCell.Interior.Pattern <> xlPatternSolid And myCell.Interior.Pattern <> xlPatternNone) Then
+ myCellAttri.FillPattern = myCellAttri.FillPattern + 1
+ End If
+
+ Exit Function
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+
+Private Sub ReportCellFormattingIssue(myName As String, myCellAttri As CellAtrributes)
+ Dim currentFunctionName As String
+ currentFunctionName = "ReportCellFormattingIssue"
+
+ On Error GoTo HandleErrors
+
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ With myIssue
+ .IssueID = CID_FORMAT
+ .IssueType = RID_STR_EXCEL_ISSUE_FORMAT
+ .SubType = RID_STR_EXCEL_SUBISSUE_ATTRIBUTES
+ .Location = .CLocationSheet
+
+ .IssueTypeXML = CSTR_ISSUE_FORMAT
+ .SubTypeXML = CSTR_SUBISSUE_ATTRIBUTES
+ .locationXML = .CXMLLocationSheet
+
+ .SubLocation = myName
+ '.Line = myCell.row
+ '.column = Chr(myCell.column + 65 - 1)
+
+ Dim noteCount As Long
+ noteCount = 0
+
+ If myCellAttri.LineStyle > 0 Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_LINE_STYLE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_DASHED_DOT
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_CELLS
+ .Values.Add myCellAttri.LineStyle
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_ATTRIBUTES_3
+ noteCount = noteCount + 1
+ End If
+ If myCellAttri.FillPattern > 0 Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FILL_PATTERN
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_PATTERNED
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_NUMBER_OF_CELLS
+ .Values.Add myCellAttri.FillPattern
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_ATTRIBUTES_4
+ noteCount = noteCount + 1
+ End If
+
+
+ mAnalysis.IssuesCountArray(CID_FORMAT) = _
+ mAnalysis.IssuesCountArray(CID_FORMAT) + 1
+ End With
+
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub CheckAllCellFunctions(CurrRange As Range, myName As String)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "CheckAllCellFunctions"
+
+ Dim myCell As Range
+ Dim startTime As Single
+
+ startTime = Timer
+
+ For Each myCell In CurrRange
+ Call CheckCellFunction(myCell, myName)
+ If (Timer - gExcelMaxRangeProcessTime > startTime) Then
+ WriteDebug currentFunctionName & " : [" & myName & _
+ "]Too much time needed, abortet cell functions check (xlCellTypeFormulas)."
+ Exit For
+ End If
+ Next
+
+FinalExit:
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub CheckCellFunction(myCell As Range, myName As String)
+ Dim currentFunctionName As String
+ currentFunctionName = "CheckCellFunction"
+
+ On Error GoTo HandleErrors
+ Dim bCellFunctionIssue As Boolean
+ Dim bCellINFOFunctionIssue As Boolean
+ Dim bCellERROR_TYPEFunctionIssue As Boolean
+ Dim bCellExternalFunctionIssue As Boolean
+ Dim bHasDateDifFunction As Boolean
+ Dim bHasPhoneticFunction As Boolean
+ Dim aFormularStr As String
+
+ aFormularStr = myCell.FormulaR1C1
+
+ If (aFormularStr = Null) Then Exit Sub
+ If (aFormularStr = "") Then Exit Sub
+
+ bCellINFOFunctionIssue = (InStr(aFormularStr, "INFO(") <> 0)
+ bCellERROR_TYPEFunctionIssue = (InStr(aFormularStr, "ERROR.TYPE(") <> 0)
+ bCellExternalFunctionIssue = (InStr(aFormularStr, ".xls!") <> 0)
+ bHasDateDifFunction = (InStr(aFormularStr, "DATEDIF(") <> 0)
+ bHasPhoneticFunction = (InStr(aFormularStr, "PHONETIC(") <> 0)
+
+ bCellFunctionIssue = bCellINFOFunctionIssue Or bCellERROR_TYPEFunctionIssue _
+ Or bCellExternalFunctionIssue Or bHasDateDifFunction Or bHasPhoneticFunction
+
+ If Not bCellFunctionIssue Then Exit Sub
+
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ With myIssue
+ .IssueID = CID_FUNCTIONS
+ .IssueType = RID_STR_EXCEL_ISSUE_FUNCTIONS
+ .Location = .CLocationSheet
+
+ .IssueTypeXML = CSTR_ISSUE_FUNCTIONS
+ .locationXML = .CXMLLocationSheet
+
+ .SubLocation = myName
+ .Line = myCell.row
+ .column = Chr(myCell.column + 65 - 1)
+
+ Dim noteCount As Long
+ noteCount = 0
+ If bCellINFOFunctionIssue Then
+ .SubTypeXML = CSTR_SUBISSUE_INFO
+ .SubType = RID_STR_EXCEL_SUBISSUE_INFO
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING
+ .Values.Add myCell.FormulaR1C1
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_1
+ noteCount = noteCount + 1
+ End If
+ If bCellERROR_TYPEFunctionIssue Then
+ .SubTypeXML = CSTR_SUBISSUE_ERROR_TYPE
+ .SubType = RID_STR_EXCEL_SUBISSUE_ERROR_TYPE
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING
+ .Values.Add myCell.FormulaR1C1
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_2
+ noteCount = noteCount + 1
+ End If
+ If bCellExternalFunctionIssue Then
+ .SubTypeXML = CSTR_SUBISSUE_EXTERNAL
+ .SubType = RID_STR_EXCEL_SUBISSUE_EXTERNAL
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING
+ .Values.Add myCell.FormulaR1C1
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_3
+ noteCount = noteCount + 1
+ End If
+ If bHasDateDifFunction Then
+ .SubTypeXML = CSTR_SUBISSUE_DATEDIF
+ .SubType = RID_STR_EXCEL_SUBISSUE_DATEDIF
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING
+ .Values.Add myCell.FormulaR1C1
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_DATEDIF
+ noteCount = noteCount + 1
+ End If
+ If bHasPhoneticFunction Then
+ .SubTypeXML = CSTR_SUBISSUE_PHONETIC
+ .SubType = RID_STR_EXCEL_SUBISSUE_PHONETIC
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_FUNCTION_STRING
+ .Values.Add myCell.FormulaR1C1
+ AddIssueDetailsNote myIssue, noteCount, RID_STR_EXCEL_NOTE_CELL_FUNCTIONS_PHONETIC
+ noteCount = noteCount + 1
+ End If
+
+ mAnalysis.IssuesCountArray(CID_FUNCTIONS) = _
+ mAnalysis.IssuesCountArray(CID_FUNCTIONS) + 1
+ End With
+
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_Password_Protection(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_Password_Protection"
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+
+ If aWB.HasPassword Or aWB.WriteReserved Then
+ With myIssue
+ .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+ .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+ .SubType = RID_STR_COMMON_SUBISSUE_PASSWORDS_PROTECTION
+
+ .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+ .SubTypeXML = CSTR_SUBISSUE_PASSWORD_PROTECTION
+ .locationXML = .CLocationWorkBook
+
+ .Location = .CLocationWorkBook
+
+ If aWB.HasPassword Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PASSWORD_TO_OPEN
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ End If
+ If aWB.WriteReserved Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PASSWORD_TO_MODIFY
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ End If
+
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+ End With
+
+ mAnalysis.Issues.Add myIssue
+ End If
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub SetDocProperties(docAnalysis As DocumentAnalysis, wb As Workbook, fso As FileSystemObject)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "SetProperties"
+ Dim f As File
+ Set f = fso.GetFile(docAnalysis.name)
+
+ Const appPropertyAppName = 9
+ Const appPropertyLastAuthor = 7
+ Const appPropertyRevision = 8
+ Const appPropertyTemplate = 6
+ Const appPropertyTimeCreated = 11
+ Const appPropertyTimeLastSaved = 12
+
+ On Error Resume Next
+ docAnalysis.PageCount = wb.Sheets.count
+ docAnalysis.Created = f.DateCreated
+ docAnalysis.Modified = f.DateLastModified
+ docAnalysis.Accessed = f.DateLastAccessed
+ docAnalysis.Printed = DateValue("01/01/1900")
+ On Error GoTo HandleErrors
+
+ On Error Resume Next 'Some apps may not support all props
+ docAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version
+ 'docAnalysis.Application = wb.BuiltinDocumentProperties(appPropertyAppName)
+ 'If InStr(docAnalysis.Application, "Microsoft") = 1 Then
+ ' docAnalysis.Application = Mid(docAnalysis.Application, Len("Microsoft") + 2)
+ 'End If
+ 'If InStr(Len(docAnalysis.Application) - 2, docAnalysis.Application, ".") = 0 Then
+ ' docAnalysis.Application = docAnalysis.Application & " " & Application.Version
+ 'End If
+
+ docAnalysis.SavedBy = _
+ wb.BuiltinDocumentProperties(appPropertyLastAuthor)
+ docAnalysis.Revision = _
+ val(wb.BuiltinDocumentProperties(appPropertyRevision))
+ docAnalysis.Template = _
+ fso.GetFileName(wb.BuiltinDocumentProperties(appPropertyTemplate))
+ docAnalysis.Modified = _
+ wb.BuiltinDocumentProperties(appPropertyTimeLastSaved)
+
+FinalExit:
+ Set f = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Sub
+
+Sub Analyze_OLEEmbedded(wrkSheet As Worksheet)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_OLEEmbedded"
+
+ ' Handle Shapes
+ Dim aShape As Shape
+ For Each aShape In wrkSheet.Shapes
+ Analyze_OLEEmbeddedSingleShape mAnalysis, aShape, wrkSheet.name
+ Analyze_Lines mAnalysis, aShape, wrkSheet.name
+ Analyze_Transparency mAnalysis, aShape, wrkSheet.name
+ Analyze_Gradients mAnalysis, aShape, wrkSheet.name
+ Next aShape
+
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_Workbook_Protection(aWB As Workbook)
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "Analyze_Workbook_Protection"
+ Dim myIssue As IssueInfo
+ Set myIssue = New IssueInfo
+ Dim bProtectSharing As Boolean
+ Dim bProtectStructure As Boolean
+ Dim bProtectWindows As Boolean
+
+ bProtectSharing = False
+ bProtectStructure = False
+ bProtectWindows = False
+
+ If Not WorkbookProtectTest(aWB, bProtectSharing, bProtectStructure, bProtectWindows) Then
+ GoTo FinalExit
+ End If
+
+ Set myIssue = New IssueInfo
+ With myIssue
+ .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+ .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+ .SubType = RID_STR_EXCEL_SUBISSUE_WORKBOOK_PROTECTION
+ .Location = .CLocationWorkBook
+
+ .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+ .SubTypeXML = CSTR_SUBISSUE_WORKBOOK_PROTECTION
+ .locationXML = .CXMLLocationWorkBook
+
+ If bProtectSharing Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_SHARING
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ End If
+ If bProtectStructure Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_STRUCTURE
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ End If
+ If bProtectWindows Then
+ .Attributes.Add RID_STR_EXCEL_ATTRIBUTE_PROTECT_TYPE_WINDOWS
+ .Values.Add RID_STR_EXCEL_ATTRIBUTE_SET
+ End If
+
+ AddIssueDetailsNote myIssue, 0, RID_STR_EXCEL_NOTE_PASSWORD_TO_OPEN
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+ mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+ End With
+
+ mAnalysis.Issues.Add myIssue
+
+FinalExit:
+ Set myIssue = Nothing
+ Exit Sub
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+
+End Sub
+
+Private Function WorkbookProtectTest(aWB As Workbook, bProtectSharing As Boolean, _
+ bProtectStructure As Boolean, bProtectWindows As Boolean) As Boolean
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "WorkbookProtectTest"
+
+ WorkbookProtectTest = False
+
+ On Error Resume Next 'Simulate Try Catch
+ aWB.UnprotectSharing sharingPassword:=" "
+ If Err.Number = 1004 Then
+ bProtectSharing = True
+ ElseIf Err.Number <> 0 Then
+ Resume HandleErrors
+ End If
+ On Error GoTo HandleErrors
+
+ On Error Resume Next 'Simulate Try Catch
+ aWB.Unprotect Password:=""
+ If Err.Number = 1004 Then
+ If aWB.ProtectStructure = True Then
+ bProtectStructure = True
+ End If
+ If aWB.ProtectWindows = True Then
+ bProtectWindows = True
+ End If
+ End If
+
+ If bProtectSharing Or bProtectStructure Or bProtectWindows Then
+ WorkbookProtectTest = True
+ End If
+FinalExit:
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+
+End Function
+
+Private Sub Class_Initialize()
+ Set mAnalysis = New DocumentAnalysis
+End Sub
+Private Sub Class_Terminate()
+ Set mAnalysis = Nothing
+End Sub
+
+Public Property Get Results() As DocumentAnalysis
+ Set Results = mAnalysis
+End Property
+Private Function FormatIssueComplex(myChart As Chart, bDataTable As Boolean, bXAxes As Boolean) As Boolean
+ On Error GoTo HandleErrors
+ Dim currentFunctionName As String
+ currentFunctionName = "FormatIssueComplex"
+
+ bXAxes = False
+
+ If myChart.HasDataTable Then
+ bDataTable = True
+ End If
+ If Not (IsPie(myChart) Or myChart.ChartType = xlDoughnut Or myChart.ChartType = xlBubble3DEffect) Then
+ If myChart.HasAxis(1) Then
+ If myChart.Axes(1).CategoryType = xlTimeScale Or myChart.Axes(1).CategoryType = xlAutomaticScale Then
+ bXAxes = True
+ End If
+ End If
+ End If
+ If bDataTable Or bXAxes Then
+ FormatIssueComplex = True
+ End If
+ Exit Function
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+
+Private Function IsAreaChart(myChart As Chart) As Boolean
+
+ If (myChart.ChartType = xlArea Or myChart.ChartType = xl3DArea Or _
+ myChart.ChartType = xlAreaStacked Or _
+ myChart.ChartType = xl3DAreaStacked Or _
+ myChart.ChartType = xlAreaStacked100 Or _
+ myChart.ChartType = xl3DAreaStacked100) _
+ Then
+ IsAreaChart = True
+ Else
+ IsAreaChart = False
+ End If
+
+End Function
+
+Private 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
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "FormatissueMinor"
+
+Dim ctype As Integer
+Dim fsize As Integer
+Dim se As Series
+Dim dl As DataLabel
+
+ FormatissueMinor = False
+ ctype = myChart.ChartType
+
+ If (ctype = xlBubble Or ctype = xlPieOfPie Or ctype = xl3DPieExploded _
+ Or ctype = xlRadarFilled Or ctype = xlBubble3DEffect _
+ Or ctype = xlRadarMarkers Or ctype = xlRadar Or ctype = xlBarOfPie _
+ Or ctype = xlXYScatter Or ctype = xlXYScatterLines Or ctype = xlXYScatterLinesNoMarkers _
+ Or ctype = xlXYScatterSmooth Or ctype = xlXYScatterSmoothNoMarkers _
+ Or ctype = xlSurface Or ctype = xlSurfaceTopView Or ctype = xlSurfaceTopViewWireframe _
+ Or ctype = xlSurfaceWireframe) Then
+ bUnsupportedType = True
+ End If
+
+ For Each se In myChart.SeriesCollection
+ On Error Resume Next ' may not have trendlines property
+ If se.Trendlines.count <> 0 Then
+ If Err.Number = 0 Then
+ bTrendline = True
+ End If
+ End If
+ If se.HasDataLabels Then
+ If Err.Number = 0 Then
+ If (IsAreaChart(myChart)) Then
+ For Each dl In se.DataLabels
+ If dl.ShowLegendKey = True Then
+ bDatalabelWithLegend = True
+ Exit For
+ End If
+ Next dl
+ Else
+ Dim pt As Point
+ For Each pt In se.Points
+ If pt.HasDataLabel Then
+ If pt.DataLabel.ShowLegendKey Then
+ bDatalabelWithLegend = True
+ Exit For
+ End If
+ End If
+ Next pt
+ End If
+ End If
+ End If
+ On Error GoTo HandleErrors
+ If bTrendline And bDatalabelWithLegend Then
+ Exit For
+ End If
+ Next se
+
+ If myChart.HasLegend Then
+ Dim legPos As Long
+ On Error Resume Next 'If legend moved accessing position will fail
+ legPos = myChart.Legend.Position
+
+ If (Err.Number <> 0) Or (legPos <> xlLegendPositionRight) Then
+ bLegendPosition = True
+ End If
+ On Error GoTo HandleErrors
+ End If
+
+ If IsPie(myChart) Then
+ bPiechartDirection = True
+ ElseIf myChart.ChartType <> xlDoughnut And myChart.ChartType <> xlBubble3DEffect Then
+ If myChart.HasAxis(xlValue, xlPrimary) Then
+ With myChart.Axes(xlValue, xlPrimary)
+ If .MajorUnitIsAuto And .MaximumScaleIsAuto And .MinimumScaleIsAuto And .MinorUnitIsAuto Then
+ bAxisInterval = True
+ End If
+ End With
+ End If
+ End If
+
+ On Error Resume Next 'If title has mixed font size accessing Font.Size will fail - Title mixed font issue
+ If myChart.HasTitle Then
+ fsize = myChart.chartTitle.Font.Size
+ If Err.Number = FontError Then
+ bTitleFont = True
+ End If
+ End If
+
+ On Error GoTo HandleErrors
+ If bUnsupportedType Or bTrendline Or bDatalabelWithLegend Or bLegendPosition Or bTitleFont Or bPiechartDirection Or bAxisInterval Then
+ FormatissueMinor = True
+ End If
+
+FinalExit:
+
+ Set se = Nothing
+ Set dl = Nothing
+ Exit Function
+
+HandleErrors:
+
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+
+End Function
+
+Private 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
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "SeriesIssue"
+SeriesIssue = False
+
+Dim Num As Integer
+Dim I As Integer
+Dim i2 As Integer
+Dim formula As String
+Dim p1 As Integer, p2 As Integer
+Dim b1 As Integer, b2 As Integer
+Dim comma1 As Integer, comma2 As Integer
+Dim starty As Integer
+Dim ctype As Integer
+Dim temp As Integer
+Dim myarray() As String
+Dim Values(3), sh
+Dim chartseries As Series
+Dim b As Boolean
+Dim bmorecolumns As Boolean
+Dim c As Boolean
+
+bmorecolumns = False
+Num = myChart.SeriesCollection.count
+
+If (Num = 0) Then Exit Function
+
+ctype = myChart.SeriesCollection(1).ChartType
+I = 0
+sh = ""
+
+ReDim Preserve myarray(Num, 3)
+
+If IsPie(myChart) And Num > 1 Then 'if pie chart has more than one series,set series number to 1
+ bmorecolumns = True
+ Num = 1
+End If
+For Each chartseries In myChart.SeriesCollection
+ On Error Resume Next
+ formula = chartseries.formula
+ If Err.Number <> 0 Then
+ GoTo FinalExit
+ End If
+ If Not bSeriesChartTypeChanged Then 'check if the chart type changed
+ temp = chartseries.ChartType
+ If temp <> ctype Then
+ bSeriesChartTypeChanged = True
+ End If
+ End If
+
+ 'get each part of the formula, if it is a single range, set the value to the array
+ p1 = InStr(1, formula, "(")
+ comma1 = InStr(1, formula, ",")
+ Values(0) = Mid(formula, p1 + 1, comma1 - p1 - 1)
+
+ If Mid(formula, comma1 + 1, 1) = "(" Then
+' Multiple ranges
+ bDatasourceNotLinkedtoCell = True
+ GoTo FinalExit
+ Else
+ If Mid(formula, comma1 + 1, 1) = "{" Then
+' Literal Array
+ bDatasourceNotLinkedtoCell = True
+ GoTo FinalExit
+ Else
+' A single range
+ comma2 = InStr(comma1 + 1, formula, ",")
+ Values(1) = Mid(formula, comma1 + 1, comma2 - comma1 - 1)
+ starty = comma2
+ End If
+ End If
+
+ If Mid(formula, starty + 1, 1) = "(" Then
+' Multiple ranges
+ bDatasourceNotLinkedtoCell = True
+ GoTo FinalExit
+ Else
+ If Mid(formula, starty + 1, 1) = "{" Then
+' Literal Array
+ bDatasourceNotLinkedtoCell = True
+ GoTo FinalExit
+ Else
+' A single range
+ comma1 = starty
+ comma2 = InStr(comma1 + 1, formula, ",")
+ Values(2) = Mid(formula, comma1 + 1, comma2 - comma1 - 1)
+ End If
+ End If
+
+ If SheetCheck(sh, Values) Then 'check if data from different sheet
+ bDatasourceOnDifferentSheet = True
+ GoTo FinalExit
+ End If
+
+ For i2 = 0 To 2 'set data to myarray, if it is range, assign the range address, else null
+ If IsRange(Values(i2)) Then
+ myarray(I, i2) = Range(Values(i2)).Address
+ 'ElseIf (Not IsRange(values(i2))) And values(i2) <> "" Then
+ ' bDatasourceNotLinkedtoCell = True
+ ' myarray(i, i2) = ""
+ Else
+ bDatasourceNotLinkedtoCell = True
+ myarray(I, i2) = ""
+ End If
+ Next i2
+
+ I = I + 1
+ If bmorecolumns Then 'if it is pie chart, exit
+ Exit For
+ End If
+Next chartseries
+
+
+c = DataCheck(myarray, Num, bCategoryandValue, bCLabelMorethanOneCell, bOneColumnRow) 'check data values and category of the chart
+
+FinalExit:
+If bSeriesChartTypeChanged Or bDatasourceNotLinkedtoCell Or bDatasourceOnDifferentSheet Or bCategoryandValue Or bCLabelMorethanOneCell Or bOneColumnRow Then
+ SeriesIssue = True
+End If
+
+Last:
+ Set chartseries = Nothing
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume Last
+End Function
+
+Private Function DataCheck(myarray() As String, Num As Integer, bCategoryandValue As Boolean, bCLabelMorethanOneCell As Boolean, bOneColumnRow As Boolean)
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "DataCheck"
+
+Dim s1() As String
+Dim v1() As String
+Dim v2() As String
+Dim c1() As String
+Dim c2() As String
+Dim bs1isrange As Boolean
+Dim bc1isrange As Boolean
+Dim bc2isrange As Boolean
+Dim j As Integer
+Dim I As Integer
+Dim btemp1 As Boolean
+Dim btemp2 As Boolean
+
+
+bs1isrange = True
+bc1isrange = True
+bc2isrange = True
+
+If myarray(0, 1) = "" Then
+ bs1isrange = False
+Else
+ s1 = SplitRange(myarray(0, 1))
+ If UBound(s1) < 4 Then
+ bOneColumnRow = True
+ GoTo FinalExit
+ End If
+ If (Asclong(s1(0)) <> Asclong(s1(2))) And (Asclong(s1(1)) <> Asclong(s1(3))) Then
+ bCLabelMorethanOneCell = True
+ GoTo FinalExit
+ End If
+
+End If
+
+If myarray(0, 0) = "" Then
+ ReDim c1(2)
+ bc1isrange = False
+ c1(0) = ""
+ c1(1) = ""
+Else
+ If InStr(1, myarray(0, 0), ":") <> 0 Then
+ bCLabelMorethanOneCell = True
+ GoTo FinalExit
+ End If
+ c1 = SplitRange(myarray(0, 0))
+End If
+v1 = SplitRange(myarray(0, 2))
+
+If bs1isrange Then
+ 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
+ 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
+ If (Not btemp1) And (Not btemp2) Then
+ bCategoryandValue = True
+ GoTo FinalExit
+ End If
+End If
+If bc1isrange Then
+ btemp1 = v1(0) = v1(2) And c1(0) = v1(0) And Asclong(c1(1)) <= Asclong(v1(1)) - 1 'data label beside row
+ btemp2 = v1(1) = v1(3) And c1(1) = v1(1) And Asclong(c1(0)) <= Asclong(v1(0)) - 1 'data label beside column
+ If (Not btemp1) And (Not btemp2) Then
+ bCategoryandValue = True
+ GoTo FinalExit
+ End If
+End If
+For I = 1 To Num - 1
+ If myarray(I, 0) = "" Then
+ ReDim c2(2)
+ c2(0) = ""
+ c2(1) = ""
+ bc2isrange = False
+ Else
+ If InStr(1, myarray(0, 1), ":") = 0 Then
+ bCLabelMorethanOneCell = True
+ GoTo FinalExit
+ End If
+ c2 = SplitRange(myarray(I, 0))
+ End If
+ v2 = SplitRange(myarray(I, 2))
+ If bc2isrange Then
+ btemp1 = v1(0) = v1(2) And c2(0) = v2(0) And Asclong(c2(1)) <= Asclong(v2(1)) - 1 'data label beside row
+ btemp2 = v2(1) = v2(3) And c2(1) = v2(1) And Asclong(c2(0)) <= Asclong(v2(0)) - 1 'data label beside column
+ If (Not btemp1) And (Not btemp2) Then
+ bCategoryandValue = True
+ GoTo FinalExit
+ 'break
+ End If
+ End If
+ If bc1isrange And bc2isrange Then
+ 'series data beside last series data in column and data label beside last series data label
+ 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)
+ 'series data beside last series data in row and data label beside laast series data label
+ 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)
+ If (Not btemp1) And (Not btemp2) Then
+ bCategoryandValue = True
+ GoTo FinalExit
+ End If
+ ElseIf Not bc2isrange Then
+ 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
+ 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
+ If (Not btemp1) And (Not btemp2) Then
+ bCategoryandValue = True
+ GoTo FinalExit
+ End If
+ End If
+ For j = 0 To 1
+ c1(j) = c2(j)
+ Next j
+ For j = 0 To 3
+ v1(j) = v2(j)
+ Next j
+ bc1isrange = bc2isrange
+ bc2isrange = True
+
+Next I
+FinalExit:
+Exit Function
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+Private Function SplitRange(a As String) As String()
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "SplitRange"
+
+Dim c1 As Integer, c2 As Integer, c3 As Integer
+Dim start As Integer
+Dim l As Integer
+Dim rearray() As String
+
+start = 2
+If a <> "" Then
+ l = InStr(1, a, ":")
+ If l = 0 Then
+ ReDim rearray(2)
+ c1 = InStr(start, a, "$")
+ rearray(0) = Mid(a, start, c1 - start)
+ rearray(1) = Mid(a, c1 + 1, Len(a) - c1)
+ Else
+ ReDim rearray(4)
+ c1 = InStr(start, a, "$")
+ rearray(0) = Mid(a, start, c1 - start)
+ c2 = InStr(c1 + 1, a, "$")
+ rearray(1) = Mid(a, c1 + 1, c2 - c1 - 2)
+ c3 = InStr(c2 + 1, a, "$")
+ rearray(2) = Mid(a, c2 + 1, c3 - c2 - 1)
+ rearray(3) = Mid(a, c3 + 1, Len(a) - c3)
+ End If
+Else
+ ReDim rearray(4)
+ rearray(0) = ""
+ rearray(1) = ""
+ rearray(2) = ""
+ rearray(3) = ""
+End If
+SplitRange = rearray
+
+Exit Function
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+Private Function Asclong(s As String) As Integer
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "Asclong"
+Asclong = 0
+
+Dim l As Integer
+Dim I As Integer
+Dim m As String
+
+l = Len(s)
+
+For I = 1 To l
+ m = Mid(s, I, 1)
+ Asclong = Asclong + Asc(m)
+Next I
+Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+Private Function SheetCheck(sh As Variant, Values() As Variant) As Boolean
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "SheetCheck"
+SheetCheck = False
+
+Dim c1 As Integer
+Dim I As Integer
+
+Dim temp
+
+For I = 0 To 2
+ If IsRange(Values(I)) Then
+ c1 = InStr(1, Values(I), "!")
+ If sh = "" Then
+ sh = Mid(Values(I), 1, c1 - 1)
+ temp = Mid(Values(I), 1, c1 - 1)
+ Else
+ temp = Mid(Values(I), 1, c1 - 1)
+ End If
+ If temp <> sh Then
+ SheetCheck = True
+ Exit Function
+ End If
+ End If
+Next I
+Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+Private Function IsRange(Ref) As Boolean
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "IsRange"
+
+Dim x As Range
+
+On Error Resume Next
+Set x = Range(Ref)
+If Err = 0 Then
+ IsRange = True
+Else
+ IsRange = False
+End If
+FinalExit:
+ Set x = Nothing
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+ Resume FinalExit
+End Function
+Private Function IsPie(myChart As Chart) As Boolean
+On Error GoTo HandleErrors
+Dim currentFunctionName As String
+currentFunctionName = "IsPie"
+Dim ctype As Integer
+ IsPie = False
+
+ ctype = myChart.ChartType
+ If (ctype = xlPie) Or _
+ (ctype = xlPieExploded) Or _
+ (ctype = xlPieOfPie) Or _
+ (ctype = xl3DPie) Or _
+ (ctype = xl3DPieExploded) Then
+
+ IsPie = True
+ End If
+ Exit Function
+
+HandleErrors:
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Function
+
+Private Function IsOldVersion(aFormat As XlFileFormat) As Boolean
+ Dim theResult As Boolean
+ Dim currentFunctionName As String
+ currentFunctionName = "IsOldVersion"
+
+ Select Case aFormat
+ Case xlExcel2, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7
+ theResult = True
+ Case xlExcel9795, xlWorkbookNormal
+ theResult = False
+ Case Else
+ WriteDebug currentFunctionName & " : " & mAnalysis.name & ": The version of this spreadsheet is not recognised"
+ End Select
+
+ IsOldVersion = theResult
+End Function
+
+
|