path: root/migrationanalysis/src/driver_docs/sources/excel/MigrationAnalyser.cls

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 2008 by Sun Microsystems, Inc.
' *
' * OpenOffice.org - a multi-platform office productivity suite
' *
' * $RCSfile: MigrationAnalyser.cls,v $
' *
' * 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