1 files changed, 824 insertions, 0 deletions
diff --git a/migrationanalysis/src/driver_docs/sources/powerpoint/MigrationAnalyser.cls b/migrationanalysis/src/driver_docs/sources/powerpoint/MigrationAnalyser.cls
new file mode 100644
index 000000000000..195f87d439a9
--- /dev/null
+++ b/migrationanalysis/src/driver_docs/sources/powerpoint/MigrationAnalyser.cls
@@ -0,0 +1,824 @@
+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
+
+
+Private mAnalysis As DocumentAnalysis
+
+'***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:
+'   powerpoint_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 containsInvalidChar As Boolean
+    containsInvalidChar = False
+    Dim currentFunctionName As String
+    currentFunctionName = "DoAnalyse"
+    mAnalysis.name = fileName
+    Dim aPres As Presentation
+    mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES
+    
+    If InStr(fileName, "[") = 0 And InStr(fileName, "]") = 0 Then 'If fileName does not contain [ AND ]
+        containsInvalidChar = False
+    Else
+        containsInvalidChar = True
+    End If
+    
+    'Cannot Turn off any AutoExce macros before loading the Presentation
+    'WordBasic.DisableAutoMacros 1
+    'On Error GoTo HandleErrors
+ 
+    On Error Resume Next ' Ignore errors on setting
+    If containsInvalidChar = True Then
+        GoTo HandleErrors
+    End If
+    Set aPres = Presentations.Open(fileName:=fileName, ReadOnly:=True)
+    If Err.Number <> 0 Then
+        mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN
+        GoTo HandleErrors
+    End If
+    On Error GoTo HandleErrors
+    
+    'MsgBox "Window: " & PPViewType(aPres.Windows(1).viewType) & _
+    '    " Pane: " & PPViewType(aPres.Windows(1).ActivePane.viewType)
+        
+    'Set Doc Properties
+    SetDocProperties mAnalysis, aPres, fso
+
+    Analyze_SlideIssues aPres
+    Analyze_Macros mAnalysis, userFormTypesDict, aPres
+    
+    ' 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
+                aPres.SaveAs preparedFullPath
+            End If
+        End If
+    End If
+
+FinalExit:
+    If Not aPres Is Nothing Then 'If Not IsEmpty(aDoc) Then
+        aPres.Saved = True
+        aPres.Close
+    End If
+    Set aPres = Nothing
+    Exit Sub
+
+HandleErrors:
+    If containsInvalidChar = False Then
+        WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+    Else
+        WriteDebug currentFunctionName & " : " & mAnalysis.name & ": The file name contains the invalid character [ or ].  Please change the file name and run analysis again."
+    End If
+    Resume FinalExit
+End Sub
+
+Sub SetDocProperties(docAnalysis As DocumentAnalysis, pres As Presentation, fso As FileSystemObject)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "SetDocProperties"
+    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 = pres.Slides.count
+    docAnalysis.Created = f.DateCreated
+    docAnalysis.Modified = f.DateLastModified
+    docAnalysis.Accessed = f.DateLastAccessed
+    docAnalysis.Printed = DateValue("01/01/1900")
+
+    On Error Resume Next 'Some apps may not support all props
+    DocAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version
+    
+    'docAnalysis.Application = pres.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 = _
+        pres.BuiltInDocumentProperties(appPropertyLastAuthor)
+    docAnalysis.Revision = _
+        val(pres.BuiltInDocumentProperties(appPropertyRevision))
+    docAnalysis.Template = _
+        fso.GetFileName(pres.BuiltInDocumentProperties(appPropertyTemplate))
+        
+FinalExit:
+    Set f = Nothing
+    Exit Sub
+    
+HandleErrors:
+    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+    Resume FinalExit
+End Sub
+
+Function PPViewType(viewType As PPViewType) As String
+
+    Select Case viewType
+        Case ppViewHandoutMaster
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_HANDOUT_MASTER
+        Case ppViewNormal
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_NORMAL
+        Case ppViewNotesMaster
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_NOTES_MASTER
+        Case ppViewNotesPage
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_NOTES_PAGE
+        Case ppViewOutline
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_OUTLINE
+        Case ppViewSlide
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE
+        Case ppViewSlideMaster
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE_MASTER
+        Case ppViewSlideSorter
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE_SORTER
+        Case ppViewTitleMaster
+            PPViewType = RID_STR_PP_ENUMERATION_VIEW_TITLE_MASTER
+        Case Else
+            PPViewType = RID_STR_PP_ENUMERATION_UNKNOWN
+    End Select
+End Function
+
+Sub Analyze_SlideIssues(curPresentation As Presentation)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_SlideIssues"
+
+    Dim mySlide As Slide
+    Dim SlideNum As Integer
+
+    SlideNum = 1
+    For Each mySlide In curPresentation.Slides
+        ActiveWindow.View.GotoSlide index:=SlideNum
+        Analyze_ShapeIssues mySlide
+        Analyze_Hyperlinks mySlide
+        Analyze_Templates mySlide
+        SlideNum = SlideNum + 1
+    Next mySlide
+
+    Analyze_TabStops curPresentation
+
+    Exit Sub
+HandleErrors:
+    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_TabStops(curPresentation As Presentation)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_TabStops"
+
+    'Dim firstSlide As Slide
+    'Dim firstShape As Shape
+    Dim mySlide As Slide
+    Dim myShape As Shape
+    Dim bInitialized, bHasDifferentDefaults As Boolean
+    Dim curDefault, lastDefault As Single
+
+    bInitialized = False
+    bHasDifferentDefaults = False
+
+    For Each mySlide In curPresentation.Slides
+        For Each myShape In mySlide.Shapes
+            If myShape.HasTextFrame Then
+                If myShape.TextFrame.HasText Then
+                    curDefault = myShape.TextFrame.Ruler.TabStops.DefaultSpacing
+                    If Not bInitialized Then
+                        bInitialized = True
+                        lastDefault = curDefault
+                        'Set firstSlide = mySlide
+                        'Set firstShape = myShape
+                    End If
+                    If curDefault <> lastDefault Then
+                        bHasDifferentDefaults = True
+                        Exit For
+                    End If
+                End If
+            End If
+        Next myShape
+        If bHasDifferentDefaults Then Exit For
+    Next mySlide
+
+    If Not bHasDifferentDefaults Then Exit Sub
+
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_RESXLS_COST_Tabstop
+        .Location = .CLocationSlide
+        
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_TABSTOP
+        .locationXML = .CXMLLocationSlide
+        
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+
+        AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_TABSTOP_NOTE
+
+        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
+
+Sub Analyze_Fonts(curPresentation As Presentation)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Fonts"
+
+    Dim myFont As Font
+    Dim bHasEmbeddedFonts As Boolean
+    
+    bHasEmbeddedFonts = False
+    For Each myFont In curPresentation.Fonts
+        If myFont.Embedded Then
+            bHasEmbeddedFonts = True
+            Exit For
+        End If
+    Next
+
+    If Not bHasEmbeddedFonts Then Exit Sub
+
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_STR_PP_SUBISSUE_FONTS
+        .Location = .CLocationSlide
+        
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_FONTS
+        .locationXML = .CXMLLocationSlide
+        
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+
+        AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_FONTS_NOTE
+
+        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
+
+Sub Analyze_Templates(mySlide As Slide)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Templates"
+
+    If mySlide.Layout <> ppLayoutTitle Then Exit Sub
+
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_RESXLS_COST_Template
+        .Location = .CLocationSlide
+
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_TEMPLATE
+        .locationXML = .CXMLLocationSlide
+        .SubLocation = mySlide.name
+
+        '.Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        '.Values.Add mySlide.name
+
+        AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_TEMPLATE_NOTE
+
+        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
+
+Sub Analyze_Hyperlinks(mySlide As Slide)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Hyperlinks"
+
+    Dim myIssue As IssueInfo
+    Dim hl As Hyperlink
+    Dim bHasMultipleFonts As Boolean
+    Dim bHasMultipleLines As Boolean
+
+    bHasMultipleFonts = False
+    bHasMultipleLines = False
+        
+    For Each hl In mySlide.Hyperlinks
+        If TypeName(hl.Parent.Parent) = "TextRange" Then
+            Dim myTextRange As TextRange
+            Dim currRun As TextRange
+            Dim currLine As TextRange
+            Dim first, last, noteCount As Long
+
+            Set myTextRange = hl.Parent.Parent
+            first = myTextRange.start
+            last = first + myTextRange.Length - 1
+            
+            For Each currRun In myTextRange.Runs
+                If (currRun.start > first And currRun.start < last) Then
+                    bHasMultipleFonts = True
+                    Exit For
+                End If
+            Next
+
+            For Each currLine In myTextRange.Lines
+                Dim lineEnd As Long
+                lineEnd = currLine.start + currLine.Length - 1
+                If (first <= lineEnd And last > lineEnd) Then
+                    bHasMultipleLines = True
+                    Exit For
+                End If
+            Next
+        End If
+
+        noteCount = 0
+        
+        If bHasMultipleFonts Then
+            Set myIssue = New IssueInfo
+
+            With myIssue
+                .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+                .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+                .SubType = RID_RESXLS_COST_Hyperlink
+                .Location = .CLocationSlide
+
+                .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+                .SubTypeXML = CSTR_SUBISSUE_HYPERLINK
+                .locationXML = .CXMLLocationSlide
+                .SubLocation = mySlide.name
+
+                .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+                .Values.Add myTextRange.Text
+
+                AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_HYPERLINK_NOTE
+
+                mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+                        mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+            End With
+            mAnalysis.Issues.Add myIssue
+            Set myIssue = Nothing
+            bHasMultipleFonts = False
+        End If
+        If bHasMultipleLines Then
+            Set myIssue = New IssueInfo
+
+            With myIssue
+                .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+                .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+                .SubType = RID_RESXLS_COST_HyperlinkSplit
+                .Location = .CLocationSlide
+
+                .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+                .SubTypeXML = CSTR_SUBISSUE_HYPERLINK_SPLIT
+                .locationXML = .CXMLLocationSlide
+                .SubLocation = mySlide.name
+
+                .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+                .Values.Add myTextRange.Text
+
+                AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_HYPERLINK_SPLIT_NOTE
+
+                mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
+                        mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
+            End With
+            mAnalysis.Issues.Add myIssue
+            Set myIssue = Nothing
+            bHasMultipleLines = False
+        End If
+    Next
+
+FinalExit:
+    Set myIssue = Nothing
+    Exit Sub
+
+HandleErrors:
+    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+    Resume FinalExit
+End Sub
+
+Sub Analyze_ShapeIssues(mySlide As Slide)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_ShapeIssues"
+    Dim myShape As Shape
+    
+    For Each myShape In mySlide.Shapes
+        'myShape.Select msoTrue
+        Analyze_Movie mySlide, myShape
+        Analyze_Comments mySlide, myShape
+        Analyze_Background mySlide, myShape
+        Analyze_Numbering mySlide, myShape
+        'Analyze global issues
+        Analyze_OLEEmbeddedSingleShape mAnalysis, myShape, mySlide.name
+        Analyze_Lines mAnalysis, myShape, mySlide.name
+        Analyze_Transparency mAnalysis, myShape, mySlide.name
+        Analyze_Gradients mAnalysis, myShape, mySlide.name
+    Next myShape
+    
+    Exit Sub
+HandleErrors:
+    WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
+End Sub
+
+Sub Analyze_Numbering(mySlide As Slide, myShape As Shape)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Numbering"
+
+    If Not myShape.HasTextFrame Then Exit Sub
+    If Not myShape.TextFrame.HasText Then Exit Sub
+    Dim shapeText As TextRange
+
+    Set shapeText = myShape.TextFrame.TextRange
+
+    If shapeText.Paragraphs.count < 2 Then Exit Sub
+    If Not (shapeText.ParagraphFormat.Bullet.Type = ppBulletMixed Or _
+            shapeText.ParagraphFormat.Bullet.Type = ppBulletNumbered) Then Exit Sub
+
+    ' OpenOffice has Problems when the numbering does not start with the first
+    ' paragraph or when there are empty paragraphs which do not have a number.
+    ' Because PowerPoint does not give us the length of each paragraph ( .Length
+    ' does not work ), we have to compute the length ourself.
+
+    Dim I As Long
+    Dim lastType As PpBulletType
+    Dim currType As PpBulletType
+    Dim lastStart As Long
+    Dim lastLength As Long
+    Dim currStart As Long
+    Dim bHasNumProblem As Boolean
+    Dim bHasEmptyPar As Boolean
+
+    bHasNumProblem = False
+    bHasEmptyPar = False
+
+    lastType = shapeText.Paragraphs(1, 0).ParagraphFormat.Bullet.Type
+    lastStart = shapeText.Paragraphs(1, 0).start
+
+    For I = 2 To shapeText.Paragraphs.count
+        currType = shapeText.Paragraphs(I, 0).ParagraphFormat.Bullet.Type
+        currStart = shapeText.Paragraphs(I, 0).start
+        lastLength = currStart - lastStart - 1
+
+        If currType <> lastType Then
+            lastType = currType
+            If currType = ppBulletNumbered Then
+                bHasNumProblem = True
+                Exit For
+            End If
+        End If
+        If lastLength = 0 Then
+            bHasEmptyPar = True
+        Else
+            If (bHasEmptyPar) Then
+                bHasNumProblem = True
+                Exit For
+            End If
+        End If
+        lastStart = currStart
+    Next I
+
+    lastLength = shapeText.Length - lastStart
+    If (lastLength <> 0) And bHasEmptyPar Then
+        bHasNumProblem = True
+    End If
+
+    If Not bHasNumProblem Then Exit Sub
+
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_RESXLS_COST_Numbering
+        .Location = .CLocationSlide
+
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_NUMBERING
+        .locationXML = .CXMLLocationSlide
+
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+
+        AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_NUMBERING_NOTE
+
+        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
+
+Sub Analyze_Background(mySlide As Slide, myShape As Shape)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Background"
+    
+    If myShape.Fill.Type <> msoFillBackground Then Exit Sub
+    
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+    Dim strCr As String
+    strCr = "" & vbCr
+    
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_RESXLS_COST_Background
+        .Location = .CLocationSlide
+        
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_BACKGROUND
+        .locationXML = .CXMLLocationSlide
+        
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+
+        AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_BACKGROUND_NOTE
+
+        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
+
+Sub Analyze_Comments(mySlide As Slide, myShape As Shape)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Comments"
+    
+    If myShape.Type <> msoComment Then Exit Sub
+    
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+    Dim strCr As String
+    strCr = "" & vbCr
+    
+    With myIssue
+        .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
+        .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
+        .SubType = RID_STR_PP_SUBISSUE_COMMENT
+        .Location = .CLocationSlide
+        
+        .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
+        .SubTypeXML = CSTR_SUBISSUE_COMMENT
+        .locationXML = .CXMLLocationSlide
+        
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+        .Attributes.Add RID_STR_PP_ATTRIBUTE_CONTENT
+        .Values.Add Replace(myShape.TextFrame.TextRange.Text, strCr, "")
+
+         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
+Sub Analyze_Movie(mySlide As Slide, myShape As Shape)
+    On Error GoTo HandleErrors
+    Dim currentFunctionName As String
+    currentFunctionName = "Analyze_Movie"
+    
+    If myShape.Type <> msoMedia Then Exit Sub
+    If myShape.MediaType <> ppMediaTypeMovie Then Exit Sub
+    
+    Dim myIssue As IssueInfo
+    Set myIssue = New IssueInfo
+    
+    With myIssue
+        .IssueID = CID_OBJECTS_GRAPHICS_TEXTBOXES
+        .IssueType = RID_STR_PP_ISSUE_OBJECTS_GRAPHICS_AND_TEXTBOXES
+        .SubType = RID_STR_PP_SUBISSUE_MOVIE
+        .Location = .CLocationSlide
+        
+        .IssueTypeXML = CSTR_ISSUE_OBJECTS_GRAPHICS_AND_TEXTBOXES
+        .SubTypeXML = CSTR_SUBISSUE_MOVIE
+        .locationXML = .CXMLLocationSlide
+        
+        .SubLocation = mySlide.name
+        .Line = myShape.top
+        .column = myShape.Left
+
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
+        .Values.Add myShape.name
+        .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE
+        .Values.Add myShape.LinkFormat.SourceFullName
+        .Attributes.Add RID_STR_PP_ATTRIBUTE_PLAYONENTRY
+        .Values.Add IIf(myShape.AnimationSettings.PlaySettings.PlayOnEntry, RID_STR_PP_TRUE, RID_STR_PP_FALSE)
+        .Attributes.Add RID_STR_PP_ATTRIBUTE_LOOP
+        .Values.Add IIf(myShape.AnimationSettings.PlaySettings.LoopUntilStopped, RID_STR_PP_TRUE, RID_STR_PP_FALSE)
+        .Attributes.Add RID_STR_PP_ATTRIBUTE_REWIND
+        .Values.Add IIf(myShape.AnimationSettings.PlaySettings.RewindMovie, RID_STR_PP_TRUE, RID_STR_PP_FALSE)
+
+         mAnalysis.IssuesCountArray(CID_OBJECTS_GRAPHICS_TEXTBOXES) = _
+                mAnalysis.IssuesCountArray(CID_OBJECTS_GRAPHICS_TEXTBOXES) + 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 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
+