1cdf0e10cSrcweirVERSION 1.0 CLASS 2cdf0e10cSrcweirBEGIN 3cdf0e10cSrcweir MultiUse = -1 'True 4cdf0e10cSrcweirEND 5cdf0e10cSrcweirAttribute VB_Name = "MigrationAnalyser" 6cdf0e10cSrcweirAttribute VB_GlobalNameSpace = False 7cdf0e10cSrcweirAttribute VB_Creatable = False 8cdf0e10cSrcweirAttribute VB_PredeclaredId = False 9cdf0e10cSrcweirAttribute VB_Exposed = False 10*d4a3fa4bSAndrew Rist'************************************************************************* 11*d4a3fa4bSAndrew Rist' 12*d4a3fa4bSAndrew Rist' Licensed to the Apache Software Foundation (ASF) under one 13*d4a3fa4bSAndrew Rist' or more contributor license agreements. See the NOTICE file 14*d4a3fa4bSAndrew Rist' distributed with this work for additional information 15*d4a3fa4bSAndrew Rist' regarding copyright ownership. The ASF licenses this file 16*d4a3fa4bSAndrew Rist' to you under the Apache License, Version 2.0 (the 17*d4a3fa4bSAndrew Rist' "License"); you may not use this file except in compliance 18*d4a3fa4bSAndrew Rist' with the License. You may obtain a copy of the License at 19*d4a3fa4bSAndrew Rist' 20*d4a3fa4bSAndrew Rist' http://www.apache.org/licenses/LICENSE-2.0 21*d4a3fa4bSAndrew Rist' 22*d4a3fa4bSAndrew Rist' Unless required by applicable law or agreed to in writing, 23*d4a3fa4bSAndrew Rist' software distributed under the License is distributed on an 24*d4a3fa4bSAndrew Rist' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY 25*d4a3fa4bSAndrew Rist' KIND, either express or implied. See the License for the 26*d4a3fa4bSAndrew Rist' specific language governing permissions and limitations 27*d4a3fa4bSAndrew Rist' under the License. 28*d4a3fa4bSAndrew Rist' 29*d4a3fa4bSAndrew Rist'************************************************************************* 30cdf0e10cSrcweir 31cdf0e10cSrcweirOption Explicit 32cdf0e10cSrcweir 33cdf0e10cSrcweir 34cdf0e10cSrcweirPrivate mAnalysis As DocumentAnalysis 35cdf0e10cSrcweir 36cdf0e10cSrcweir'***ADDING-ISSUE: Use Following Skeleton as Guideline for Adding Issue 37cdf0e10cSrcweir' For complete list of all RID_STR_... for Issues (IssueType), SubIssues (SubType) and Attributes refer to: 38cdf0e10cSrcweir' powerpoint_res.bas and common_res.bas 39cdf0e10cSrcweir' 40cdf0e10cSrcweir' For complete list of all CID_... for Issue Categories(IssueID) and 41cdf0e10cSrcweir' CSTR_... for XML Issues (IssueTypeXML) and XML SubIssues (SubTypeXML) refer to: 42cdf0e10cSrcweir' ApplicationSpecific.bas and CommonMigrationAnalyser.bas 43cdf0e10cSrcweir' 44cdf0e10cSrcweir' You should not have to add any new Issue Categories or matching IssueTypes, only new SubIssues 45cdf0e10cSrcweirSub Analyze_SKELETON() 46cdf0e10cSrcweir On Error GoTo HandleErrors 47cdf0e10cSrcweir Dim currentFunctionName As String 48cdf0e10cSrcweir currentFunctionName = "Analyze_SKELETON" 49cdf0e10cSrcweir Dim myIssue As IssueInfo 50cdf0e10cSrcweir Set myIssue = New IssueInfo 51cdf0e10cSrcweir 52cdf0e10cSrcweir With myIssue 53cdf0e10cSrcweir .IssueID = CID_VBA_MACROS 'Issue Category 54cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_VBA_MACROS 'Issue String 55cdf0e10cSrcweir .SubType = RID_STR_COMMON_SUBISSUE_PROPERTIES 'SubIssue String 56cdf0e10cSrcweir .Location = .CLocationDocument 'Location string 57cdf0e10cSrcweir 58cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_VBA_MACROS 'Non localised XML Issue String 59cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_PROPERTIES 'Non localised XML SubIssue String 60cdf0e10cSrcweir .locationXML = .CXMLLocationDocument 'Non localised XML location 61cdf0e10cSrcweir 62cdf0e10cSrcweir .SubLocation = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 63cdf0e10cSrcweir .Line = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 64cdf0e10cSrcweir .column = 0 'if not set will default to RID_STR_NOT_AVAILABLE_SHORTHAND 65cdf0e10cSrcweir 66cdf0e10cSrcweir ' Add as many Attribute Value pairs as needed 67cdf0e10cSrcweir ' Note: following must always be true - Attributes.Count = Values.Count 68cdf0e10cSrcweir .Attributes.Add "AAA" 69cdf0e10cSrcweir .Values.Add "foobar" 70cdf0e10cSrcweir 71cdf0e10cSrcweir ' Use AddIssueDetailsNote to add notes to the Issue Details if required 72cdf0e10cSrcweir ' Public Sub AddIssueDetailsNote(myIssue As IssueInfo, noteNum As Long, noteStr As String, _ 73cdf0e10cSrcweir ' Optional preStr As String = RID_STR_COMMON_NOTE_PRE) 74cdf0e10cSrcweir ' Where preStr is prepended to the output, with "Note" as the default 75cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_COMMON_NOTE_DOCUMENT_PROPERTIES_LOST 76cdf0e10cSrcweir 77cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_VBA_MACROS) = _ 78cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_VBA_MACROS) + 1 79cdf0e10cSrcweir End With 80cdf0e10cSrcweir 81cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 82cdf0e10cSrcweir 83cdf0e10cSrcweirFinalExit: 84cdf0e10cSrcweir Set myIssue = Nothing 85cdf0e10cSrcweir Exit Sub 86cdf0e10cSrcweir 87cdf0e10cSrcweirHandleErrors: 88cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 89cdf0e10cSrcweir Resume FinalExit 90cdf0e10cSrcweirEnd Sub 91cdf0e10cSrcweir 92cdf0e10cSrcweirSub DoAnalyse(fileName As String, userFormTypesDict As Scripting.Dictionary, _ 93cdf0e10cSrcweir startDir As String, storeToDir As String, fso As FileSystemObject) 94cdf0e10cSrcweir On Error GoTo HandleErrors 95cdf0e10cSrcweir Dim containsInvalidChar As Boolean 96cdf0e10cSrcweir containsInvalidChar = False 97cdf0e10cSrcweir Dim currentFunctionName As String 98cdf0e10cSrcweir currentFunctionName = "DoAnalyse" 99cdf0e10cSrcweir mAnalysis.name = fileName 100cdf0e10cSrcweir Dim aPres As Presentation 101cdf0e10cSrcweir mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES 102cdf0e10cSrcweir 103cdf0e10cSrcweir If InStr(fileName, "[") = 0 And InStr(fileName, "]") = 0 Then 'If fileName does not contain [ AND ] 104cdf0e10cSrcweir containsInvalidChar = False 105cdf0e10cSrcweir Else 106cdf0e10cSrcweir containsInvalidChar = True 107cdf0e10cSrcweir End If 108cdf0e10cSrcweir 109cdf0e10cSrcweir 'Cannot Turn off any AutoExce macros before loading the Presentation 110cdf0e10cSrcweir 'WordBasic.DisableAutoMacros 1 111cdf0e10cSrcweir 'On Error GoTo HandleErrors 112cdf0e10cSrcweir 113cdf0e10cSrcweir On Error Resume Next ' Ignore errors on setting 114cdf0e10cSrcweir If containsInvalidChar = True Then 115cdf0e10cSrcweir GoTo HandleErrors 116cdf0e10cSrcweir End If 117cdf0e10cSrcweir Set aPres = Presentations.Open(fileName:=fileName, ReadOnly:=True) 118cdf0e10cSrcweir If Err.Number <> 0 Then 119cdf0e10cSrcweir mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN 120cdf0e10cSrcweir GoTo HandleErrors 121cdf0e10cSrcweir End If 122cdf0e10cSrcweir On Error GoTo HandleErrors 123cdf0e10cSrcweir 124cdf0e10cSrcweir 'MsgBox "Window: " & PPViewType(aPres.Windows(1).viewType) & _ 125cdf0e10cSrcweir ' " Pane: " & PPViewType(aPres.Windows(1).ActivePane.viewType) 126cdf0e10cSrcweir 127cdf0e10cSrcweir 'Set Doc Properties 128cdf0e10cSrcweir SetDocProperties mAnalysis, aPres, fso 129cdf0e10cSrcweir 130cdf0e10cSrcweir Analyze_SlideIssues aPres 131cdf0e10cSrcweir Analyze_Macros mAnalysis, userFormTypesDict, aPres 132cdf0e10cSrcweir 133cdf0e10cSrcweir ' Doc Preparation only 134cdf0e10cSrcweir ' Save document with any fixed issues under <storeToDir>\prepared\<source doc name> 135cdf0e10cSrcweir If mAnalysis.PreparableIssuesCount > 0 And CheckDoPrepare Then 136cdf0e10cSrcweir Dim preparedFullPath As String 137cdf0e10cSrcweir preparedFullPath = GetPreparedFullPath(mAnalysis.name, startDir, storeToDir, fso) 138cdf0e10cSrcweir If preparedFullPath <> "" Then 139cdf0e10cSrcweir If fso.FileExists(preparedFullPath) Then 140cdf0e10cSrcweir fso.DeleteFile preparedFullPath, True 141cdf0e10cSrcweir End If 142cdf0e10cSrcweir If fso.FolderExists(fso.GetParentFolderName(preparedFullPath)) Then 143cdf0e10cSrcweir aPres.SaveAs preparedFullPath 144cdf0e10cSrcweir End If 145cdf0e10cSrcweir End If 146cdf0e10cSrcweir End If 147cdf0e10cSrcweir 148cdf0e10cSrcweirFinalExit: 149cdf0e10cSrcweir If Not aPres Is Nothing Then 'If Not IsEmpty(aDoc) Then 150cdf0e10cSrcweir aPres.Saved = True 151cdf0e10cSrcweir aPres.Close 152cdf0e10cSrcweir End If 153cdf0e10cSrcweir Set aPres = Nothing 154cdf0e10cSrcweir Exit Sub 155cdf0e10cSrcweir 156cdf0e10cSrcweirHandleErrors: 157cdf0e10cSrcweir If containsInvalidChar = False Then 158cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 159cdf0e10cSrcweir Else 160cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": The file name contains the invalid character [ or ]. Please change the file name and run analysis again." 161cdf0e10cSrcweir End If 162cdf0e10cSrcweir Resume FinalExit 163cdf0e10cSrcweirEnd Sub 164cdf0e10cSrcweir 165cdf0e10cSrcweirSub SetDocProperties(docAnalysis As DocumentAnalysis, pres As Presentation, fso As FileSystemObject) 166cdf0e10cSrcweir On Error GoTo HandleErrors 167cdf0e10cSrcweir Dim currentFunctionName As String 168cdf0e10cSrcweir currentFunctionName = "SetDocProperties" 169cdf0e10cSrcweir Dim f As File 170cdf0e10cSrcweir Set f = fso.GetFile(docAnalysis.name) 171cdf0e10cSrcweir 172cdf0e10cSrcweir Const appPropertyAppName = 9 173cdf0e10cSrcweir Const appPropertyLastAuthor = 7 174cdf0e10cSrcweir Const appPropertyRevision = 8 175cdf0e10cSrcweir Const appPropertyTemplate = 6 176cdf0e10cSrcweir Const appPropertyTimeCreated = 11 177cdf0e10cSrcweir Const appPropertyTimeLastSaved = 12 178cdf0e10cSrcweir 179cdf0e10cSrcweir On Error Resume Next 180cdf0e10cSrcweir docAnalysis.PageCount = pres.Slides.count 181cdf0e10cSrcweir docAnalysis.Created = f.DateCreated 182cdf0e10cSrcweir docAnalysis.Modified = f.DateLastModified 183cdf0e10cSrcweir docAnalysis.Accessed = f.DateLastAccessed 184cdf0e10cSrcweir docAnalysis.Printed = DateValue("01/01/1900") 185cdf0e10cSrcweir 186cdf0e10cSrcweir On Error Resume Next 'Some apps may not support all props 187cdf0e10cSrcweir DocAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version 188cdf0e10cSrcweir 189cdf0e10cSrcweir 'docAnalysis.Application = pres.BuiltInDocumentProperties(appPropertyAppName) 190cdf0e10cSrcweir 'If InStr(docAnalysis.Application, "Microsoft") = 1 Then 191cdf0e10cSrcweir ' docAnalysis.Application = Mid(docAnalysis.Application, Len("Microsoft") + 2) 192cdf0e10cSrcweir 'End If 193cdf0e10cSrcweir 'If InStr(Len(docAnalysis.Application) - 2, docAnalysis.Application, ".") = 0 Then 194cdf0e10cSrcweir ' docAnalysis.Application = docAnalysis.Application & " " & Application.Version 195cdf0e10cSrcweir 'End If 196cdf0e10cSrcweir 197cdf0e10cSrcweir docAnalysis.SavedBy = _ 198cdf0e10cSrcweir pres.BuiltInDocumentProperties(appPropertyLastAuthor) 199cdf0e10cSrcweir docAnalysis.Revision = _ 200cdf0e10cSrcweir val(pres.BuiltInDocumentProperties(appPropertyRevision)) 201cdf0e10cSrcweir docAnalysis.Template = _ 202cdf0e10cSrcweir fso.GetFileName(pres.BuiltInDocumentProperties(appPropertyTemplate)) 203cdf0e10cSrcweir 204cdf0e10cSrcweirFinalExit: 205cdf0e10cSrcweir Set f = Nothing 206cdf0e10cSrcweir Exit Sub 207cdf0e10cSrcweir 208cdf0e10cSrcweirHandleErrors: 209cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 210cdf0e10cSrcweir Resume FinalExit 211cdf0e10cSrcweirEnd Sub 212cdf0e10cSrcweir 213cdf0e10cSrcweirFunction PPViewType(viewType As PPViewType) As String 214cdf0e10cSrcweir 215cdf0e10cSrcweir Select Case viewType 216cdf0e10cSrcweir Case ppViewHandoutMaster 217cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_HANDOUT_MASTER 218cdf0e10cSrcweir Case ppViewNormal 219cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_NORMAL 220cdf0e10cSrcweir Case ppViewNotesMaster 221cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_NOTES_MASTER 222cdf0e10cSrcweir Case ppViewNotesPage 223cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_NOTES_PAGE 224cdf0e10cSrcweir Case ppViewOutline 225cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_OUTLINE 226cdf0e10cSrcweir Case ppViewSlide 227cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE 228cdf0e10cSrcweir Case ppViewSlideMaster 229cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE_MASTER 230cdf0e10cSrcweir Case ppViewSlideSorter 231cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_SLIDE_SORTER 232cdf0e10cSrcweir Case ppViewTitleMaster 233cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_VIEW_TITLE_MASTER 234cdf0e10cSrcweir Case Else 235cdf0e10cSrcweir PPViewType = RID_STR_PP_ENUMERATION_UNKNOWN 236cdf0e10cSrcweir End Select 237cdf0e10cSrcweirEnd Function 238cdf0e10cSrcweir 239cdf0e10cSrcweirSub Analyze_SlideIssues(curPresentation As Presentation) 240cdf0e10cSrcweir On Error GoTo HandleErrors 241cdf0e10cSrcweir Dim currentFunctionName As String 242cdf0e10cSrcweir currentFunctionName = "Analyze_SlideIssues" 243cdf0e10cSrcweir 244cdf0e10cSrcweir Dim mySlide As Slide 245cdf0e10cSrcweir Dim SlideNum As Integer 246cdf0e10cSrcweir 247cdf0e10cSrcweir SlideNum = 1 248cdf0e10cSrcweir For Each mySlide In curPresentation.Slides 249cdf0e10cSrcweir ActiveWindow.View.GotoSlide index:=SlideNum 250cdf0e10cSrcweir Analyze_ShapeIssues mySlide 251cdf0e10cSrcweir Analyze_Hyperlinks mySlide 252cdf0e10cSrcweir Analyze_Templates mySlide 253cdf0e10cSrcweir SlideNum = SlideNum + 1 254cdf0e10cSrcweir Next mySlide 255cdf0e10cSrcweir 256cdf0e10cSrcweir Analyze_TabStops curPresentation 257cdf0e10cSrcweir 258cdf0e10cSrcweir Exit Sub 259cdf0e10cSrcweirHandleErrors: 260cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 261cdf0e10cSrcweirEnd Sub 262cdf0e10cSrcweir 263cdf0e10cSrcweirSub Analyze_TabStops(curPresentation As Presentation) 264cdf0e10cSrcweir On Error GoTo HandleErrors 265cdf0e10cSrcweir Dim currentFunctionName As String 266cdf0e10cSrcweir currentFunctionName = "Analyze_TabStops" 267cdf0e10cSrcweir 268cdf0e10cSrcweir 'Dim firstSlide As Slide 269cdf0e10cSrcweir 'Dim firstShape As Shape 270cdf0e10cSrcweir Dim mySlide As Slide 271cdf0e10cSrcweir Dim myShape As Shape 272cdf0e10cSrcweir Dim bInitialized, bHasDifferentDefaults As Boolean 273cdf0e10cSrcweir Dim curDefault, lastDefault As Single 274cdf0e10cSrcweir 275cdf0e10cSrcweir bInitialized = False 276cdf0e10cSrcweir bHasDifferentDefaults = False 277cdf0e10cSrcweir 278cdf0e10cSrcweir For Each mySlide In curPresentation.Slides 279cdf0e10cSrcweir For Each myShape In mySlide.Shapes 280cdf0e10cSrcweir If myShape.HasTextFrame Then 281cdf0e10cSrcweir If myShape.TextFrame.HasText Then 282cdf0e10cSrcweir curDefault = myShape.TextFrame.Ruler.TabStops.DefaultSpacing 283cdf0e10cSrcweir If Not bInitialized Then 284cdf0e10cSrcweir bInitialized = True 285cdf0e10cSrcweir lastDefault = curDefault 286cdf0e10cSrcweir 'Set firstSlide = mySlide 287cdf0e10cSrcweir 'Set firstShape = myShape 288cdf0e10cSrcweir End If 289cdf0e10cSrcweir If curDefault <> lastDefault Then 290cdf0e10cSrcweir bHasDifferentDefaults = True 291cdf0e10cSrcweir Exit For 292cdf0e10cSrcweir End If 293cdf0e10cSrcweir End If 294cdf0e10cSrcweir End If 295cdf0e10cSrcweir Next myShape 296cdf0e10cSrcweir If bHasDifferentDefaults Then Exit For 297cdf0e10cSrcweir Next mySlide 298cdf0e10cSrcweir 299cdf0e10cSrcweir If Not bHasDifferentDefaults Then Exit Sub 300cdf0e10cSrcweir 301cdf0e10cSrcweir Dim myIssue As IssueInfo 302cdf0e10cSrcweir Set myIssue = New IssueInfo 303cdf0e10cSrcweir 304cdf0e10cSrcweir With myIssue 305cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 306cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 307cdf0e10cSrcweir .SubType = RID_RESXLS_COST_Tabstop 308cdf0e10cSrcweir .Location = .CLocationSlide 309cdf0e10cSrcweir 310cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 311cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_TABSTOP 312cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 313cdf0e10cSrcweir 314cdf0e10cSrcweir .SubLocation = mySlide.name 315cdf0e10cSrcweir .Line = myShape.top 316cdf0e10cSrcweir .column = myShape.Left 317cdf0e10cSrcweir 318cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 319cdf0e10cSrcweir .Values.Add myShape.name 320cdf0e10cSrcweir 321cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_TABSTOP_NOTE 322cdf0e10cSrcweir 323cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 324cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 325cdf0e10cSrcweir End With 326cdf0e10cSrcweir 327cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 328cdf0e10cSrcweir 329cdf0e10cSrcweirFinalExit: 330cdf0e10cSrcweir Set myIssue = Nothing 331cdf0e10cSrcweir Exit Sub 332cdf0e10cSrcweir 333cdf0e10cSrcweirHandleErrors: 334cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 335cdf0e10cSrcweir Resume FinalExit 336cdf0e10cSrcweirEnd Sub 337cdf0e10cSrcweir 338cdf0e10cSrcweirSub Analyze_Fonts(curPresentation As Presentation) 339cdf0e10cSrcweir On Error GoTo HandleErrors 340cdf0e10cSrcweir Dim currentFunctionName As String 341cdf0e10cSrcweir currentFunctionName = "Analyze_Fonts" 342cdf0e10cSrcweir 343cdf0e10cSrcweir Dim myFont As Font 344cdf0e10cSrcweir Dim bHasEmbeddedFonts As Boolean 345cdf0e10cSrcweir 346cdf0e10cSrcweir bHasEmbeddedFonts = False 347cdf0e10cSrcweir For Each myFont In curPresentation.Fonts 348cdf0e10cSrcweir If myFont.Embedded Then 349cdf0e10cSrcweir bHasEmbeddedFonts = True 350cdf0e10cSrcweir Exit For 351cdf0e10cSrcweir End If 352cdf0e10cSrcweir Next 353cdf0e10cSrcweir 354cdf0e10cSrcweir If Not bHasEmbeddedFonts Then Exit Sub 355cdf0e10cSrcweir 356cdf0e10cSrcweir Dim myIssue As IssueInfo 357cdf0e10cSrcweir Set myIssue = New IssueInfo 358cdf0e10cSrcweir 359cdf0e10cSrcweir With myIssue 360cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 361cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 362cdf0e10cSrcweir .SubType = RID_STR_PP_SUBISSUE_FONTS 363cdf0e10cSrcweir .Location = .CLocationSlide 364cdf0e10cSrcweir 365cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 366cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_FONTS 367cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 368cdf0e10cSrcweir 369cdf0e10cSrcweir .SubLocation = mySlide.name 370cdf0e10cSrcweir .Line = myShape.top 371cdf0e10cSrcweir .column = myShape.Left 372cdf0e10cSrcweir 373cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 374cdf0e10cSrcweir .Values.Add myShape.name 375cdf0e10cSrcweir 376cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_FONTS_NOTE 377cdf0e10cSrcweir 378cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 379cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 380cdf0e10cSrcweir End With 381cdf0e10cSrcweir 382cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 383cdf0e10cSrcweir 384cdf0e10cSrcweirFinalExit: 385cdf0e10cSrcweir Set myIssue = Nothing 386cdf0e10cSrcweir Exit Sub 387cdf0e10cSrcweir 388cdf0e10cSrcweirHandleErrors: 389cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 390cdf0e10cSrcweir Resume FinalExit 391cdf0e10cSrcweirEnd Sub 392cdf0e10cSrcweir 393cdf0e10cSrcweirSub Analyze_Templates(mySlide As Slide) 394cdf0e10cSrcweir On Error GoTo HandleErrors 395cdf0e10cSrcweir Dim currentFunctionName As String 396cdf0e10cSrcweir currentFunctionName = "Analyze_Templates" 397cdf0e10cSrcweir 398cdf0e10cSrcweir If mySlide.Layout <> ppLayoutTitle Then Exit Sub 399cdf0e10cSrcweir 400cdf0e10cSrcweir Dim myIssue As IssueInfo 401cdf0e10cSrcweir Set myIssue = New IssueInfo 402cdf0e10cSrcweir 403cdf0e10cSrcweir With myIssue 404cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 405cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 406cdf0e10cSrcweir .SubType = RID_RESXLS_COST_Template 407cdf0e10cSrcweir .Location = .CLocationSlide 408cdf0e10cSrcweir 409cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 410cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_TEMPLATE 411cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 412cdf0e10cSrcweir .SubLocation = mySlide.name 413cdf0e10cSrcweir 414cdf0e10cSrcweir '.Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 415cdf0e10cSrcweir '.Values.Add mySlide.name 416cdf0e10cSrcweir 417cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_TEMPLATE_NOTE 418cdf0e10cSrcweir 419cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 420cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 421cdf0e10cSrcweir End With 422cdf0e10cSrcweir 423cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 424cdf0e10cSrcweir 425cdf0e10cSrcweirFinalExit: 426cdf0e10cSrcweir Set myIssue = Nothing 427cdf0e10cSrcweir Exit Sub 428cdf0e10cSrcweir 429cdf0e10cSrcweirHandleErrors: 430cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 431cdf0e10cSrcweir Resume FinalExit 432cdf0e10cSrcweirEnd Sub 433cdf0e10cSrcweir 434cdf0e10cSrcweirSub Analyze_Hyperlinks(mySlide As Slide) 435cdf0e10cSrcweir On Error GoTo HandleErrors 436cdf0e10cSrcweir Dim currentFunctionName As String 437cdf0e10cSrcweir currentFunctionName = "Analyze_Hyperlinks" 438cdf0e10cSrcweir 439cdf0e10cSrcweir Dim myIssue As IssueInfo 440cdf0e10cSrcweir Dim hl As Hyperlink 441cdf0e10cSrcweir Dim bHasMultipleFonts As Boolean 442cdf0e10cSrcweir Dim bHasMultipleLines As Boolean 443cdf0e10cSrcweir 444cdf0e10cSrcweir bHasMultipleFonts = False 445cdf0e10cSrcweir bHasMultipleLines = False 446cdf0e10cSrcweir 447cdf0e10cSrcweir For Each hl In mySlide.Hyperlinks 448cdf0e10cSrcweir If TypeName(hl.Parent.Parent) = "TextRange" Then 449cdf0e10cSrcweir Dim myTextRange As TextRange 450cdf0e10cSrcweir Dim currRun As TextRange 451cdf0e10cSrcweir Dim currLine As TextRange 452cdf0e10cSrcweir Dim first, last, noteCount As Long 453cdf0e10cSrcweir 454cdf0e10cSrcweir Set myTextRange = hl.Parent.Parent 455cdf0e10cSrcweir first = myTextRange.start 456cdf0e10cSrcweir last = first + myTextRange.Length - 1 457cdf0e10cSrcweir 458cdf0e10cSrcweir For Each currRun In myTextRange.Runs 459cdf0e10cSrcweir If (currRun.start > first And currRun.start < last) Then 460cdf0e10cSrcweir bHasMultipleFonts = True 461cdf0e10cSrcweir Exit For 462cdf0e10cSrcweir End If 463cdf0e10cSrcweir Next 464cdf0e10cSrcweir 465cdf0e10cSrcweir For Each currLine In myTextRange.Lines 466cdf0e10cSrcweir Dim lineEnd As Long 467cdf0e10cSrcweir lineEnd = currLine.start + currLine.Length - 1 468cdf0e10cSrcweir If (first <= lineEnd And last > lineEnd) Then 469cdf0e10cSrcweir bHasMultipleLines = True 470cdf0e10cSrcweir Exit For 471cdf0e10cSrcweir End If 472cdf0e10cSrcweir Next 473cdf0e10cSrcweir End If 474cdf0e10cSrcweir 475cdf0e10cSrcweir noteCount = 0 476cdf0e10cSrcweir 477cdf0e10cSrcweir If bHasMultipleFonts Then 478cdf0e10cSrcweir Set myIssue = New IssueInfo 479cdf0e10cSrcweir 480cdf0e10cSrcweir With myIssue 481cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 482cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 483cdf0e10cSrcweir .SubType = RID_RESXLS_COST_Hyperlink 484cdf0e10cSrcweir .Location = .CLocationSlide 485cdf0e10cSrcweir 486cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 487cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_HYPERLINK 488cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 489cdf0e10cSrcweir .SubLocation = mySlide.name 490cdf0e10cSrcweir 491cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 492cdf0e10cSrcweir .Values.Add myTextRange.Text 493cdf0e10cSrcweir 494cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_HYPERLINK_NOTE 495cdf0e10cSrcweir 496cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 497cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 498cdf0e10cSrcweir End With 499cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 500cdf0e10cSrcweir Set myIssue = Nothing 501cdf0e10cSrcweir bHasMultipleFonts = False 502cdf0e10cSrcweir End If 503cdf0e10cSrcweir If bHasMultipleLines Then 504cdf0e10cSrcweir Set myIssue = New IssueInfo 505cdf0e10cSrcweir 506cdf0e10cSrcweir With myIssue 507cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 508cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 509cdf0e10cSrcweir .SubType = RID_RESXLS_COST_HyperlinkSplit 510cdf0e10cSrcweir .Location = .CLocationSlide 511cdf0e10cSrcweir 512cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 513cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_HYPERLINK_SPLIT 514cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 515cdf0e10cSrcweir .SubLocation = mySlide.name 516cdf0e10cSrcweir 517cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 518cdf0e10cSrcweir .Values.Add myTextRange.Text 519cdf0e10cSrcweir 520cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_HYPERLINK_SPLIT_NOTE 521cdf0e10cSrcweir 522cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 523cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 524cdf0e10cSrcweir End With 525cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 526cdf0e10cSrcweir Set myIssue = Nothing 527cdf0e10cSrcweir bHasMultipleLines = False 528cdf0e10cSrcweir End If 529cdf0e10cSrcweir Next 530cdf0e10cSrcweir 531cdf0e10cSrcweirFinalExit: 532cdf0e10cSrcweir Set myIssue = Nothing 533cdf0e10cSrcweir Exit Sub 534cdf0e10cSrcweir 535cdf0e10cSrcweirHandleErrors: 536cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 537cdf0e10cSrcweir Resume FinalExit 538cdf0e10cSrcweirEnd Sub 539cdf0e10cSrcweir 540cdf0e10cSrcweirSub Analyze_ShapeIssues(mySlide As Slide) 541cdf0e10cSrcweir On Error GoTo HandleErrors 542cdf0e10cSrcweir Dim currentFunctionName As String 543cdf0e10cSrcweir currentFunctionName = "Analyze_ShapeIssues" 544cdf0e10cSrcweir Dim myShape As Shape 545cdf0e10cSrcweir 546cdf0e10cSrcweir For Each myShape In mySlide.Shapes 547cdf0e10cSrcweir 'myShape.Select msoTrue 548cdf0e10cSrcweir Analyze_Movie mySlide, myShape 549cdf0e10cSrcweir Analyze_Comments mySlide, myShape 550cdf0e10cSrcweir Analyze_Background mySlide, myShape 551cdf0e10cSrcweir Analyze_Numbering mySlide, myShape 552cdf0e10cSrcweir 'Analyze global issues 553cdf0e10cSrcweir Analyze_OLEEmbeddedSingleShape mAnalysis, myShape, mySlide.name 554cdf0e10cSrcweir Analyze_Lines mAnalysis, myShape, mySlide.name 555cdf0e10cSrcweir Analyze_Transparency mAnalysis, myShape, mySlide.name 556cdf0e10cSrcweir Analyze_Gradients mAnalysis, myShape, mySlide.name 557cdf0e10cSrcweir Next myShape 558cdf0e10cSrcweir 559cdf0e10cSrcweir Exit Sub 560cdf0e10cSrcweirHandleErrors: 561cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 562cdf0e10cSrcweirEnd Sub 563cdf0e10cSrcweir 564cdf0e10cSrcweirSub Analyze_Numbering(mySlide As Slide, myShape As Shape) 565cdf0e10cSrcweir On Error GoTo HandleErrors 566cdf0e10cSrcweir Dim currentFunctionName As String 567cdf0e10cSrcweir currentFunctionName = "Analyze_Numbering" 568cdf0e10cSrcweir 569cdf0e10cSrcweir If Not myShape.HasTextFrame Then Exit Sub 570cdf0e10cSrcweir If Not myShape.TextFrame.HasText Then Exit Sub 571cdf0e10cSrcweir Dim shapeText As TextRange 572cdf0e10cSrcweir 573cdf0e10cSrcweir Set shapeText = myShape.TextFrame.TextRange 574cdf0e10cSrcweir 575cdf0e10cSrcweir If shapeText.Paragraphs.count < 2 Then Exit Sub 576cdf0e10cSrcweir If Not (shapeText.ParagraphFormat.Bullet.Type = ppBulletMixed Or _ 577cdf0e10cSrcweir shapeText.ParagraphFormat.Bullet.Type = ppBulletNumbered) Then Exit Sub 578cdf0e10cSrcweir 579cdf0e10cSrcweir ' OpenOffice has Problems when the numbering does not start with the first 580cdf0e10cSrcweir ' paragraph or when there are empty paragraphs which do not have a number. 581cdf0e10cSrcweir ' Because PowerPoint does not give us the length of each paragraph ( .Length 582cdf0e10cSrcweir ' does not work ), we have to compute the length ourself. 583cdf0e10cSrcweir 584cdf0e10cSrcweir Dim I As Long 585cdf0e10cSrcweir Dim lastType As PpBulletType 586cdf0e10cSrcweir Dim currType As PpBulletType 587cdf0e10cSrcweir Dim lastStart As Long 588cdf0e10cSrcweir Dim lastLength As Long 589cdf0e10cSrcweir Dim currStart As Long 590cdf0e10cSrcweir Dim bHasNumProblem As Boolean 591cdf0e10cSrcweir Dim bHasEmptyPar As Boolean 592cdf0e10cSrcweir 593cdf0e10cSrcweir bHasNumProblem = False 594cdf0e10cSrcweir bHasEmptyPar = False 595cdf0e10cSrcweir 596cdf0e10cSrcweir lastType = shapeText.Paragraphs(1, 0).ParagraphFormat.Bullet.Type 597cdf0e10cSrcweir lastStart = shapeText.Paragraphs(1, 0).start 598cdf0e10cSrcweir 599cdf0e10cSrcweir For I = 2 To shapeText.Paragraphs.count 600cdf0e10cSrcweir currType = shapeText.Paragraphs(I, 0).ParagraphFormat.Bullet.Type 601cdf0e10cSrcweir currStart = shapeText.Paragraphs(I, 0).start 602cdf0e10cSrcweir lastLength = currStart - lastStart - 1 603cdf0e10cSrcweir 604cdf0e10cSrcweir If currType <> lastType Then 605cdf0e10cSrcweir lastType = currType 606cdf0e10cSrcweir If currType = ppBulletNumbered Then 607cdf0e10cSrcweir bHasNumProblem = True 608cdf0e10cSrcweir Exit For 609cdf0e10cSrcweir End If 610cdf0e10cSrcweir End If 611cdf0e10cSrcweir If lastLength = 0 Then 612cdf0e10cSrcweir bHasEmptyPar = True 613cdf0e10cSrcweir Else 614cdf0e10cSrcweir If (bHasEmptyPar) Then 615cdf0e10cSrcweir bHasNumProblem = True 616cdf0e10cSrcweir Exit For 617cdf0e10cSrcweir End If 618cdf0e10cSrcweir End If 619cdf0e10cSrcweir lastStart = currStart 620cdf0e10cSrcweir Next I 621cdf0e10cSrcweir 622cdf0e10cSrcweir lastLength = shapeText.Length - lastStart 623cdf0e10cSrcweir If (lastLength <> 0) And bHasEmptyPar Then 624cdf0e10cSrcweir bHasNumProblem = True 625cdf0e10cSrcweir End If 626cdf0e10cSrcweir 627cdf0e10cSrcweir If Not bHasNumProblem Then Exit Sub 628cdf0e10cSrcweir 629cdf0e10cSrcweir Dim myIssue As IssueInfo 630cdf0e10cSrcweir Set myIssue = New IssueInfo 631cdf0e10cSrcweir 632cdf0e10cSrcweir With myIssue 633cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 634cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 635cdf0e10cSrcweir .SubType = RID_RESXLS_COST_Numbering 636cdf0e10cSrcweir .Location = .CLocationSlide 637cdf0e10cSrcweir 638cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 639cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_NUMBERING 640cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 641cdf0e10cSrcweir 642cdf0e10cSrcweir .SubLocation = mySlide.name 643cdf0e10cSrcweir .Line = myShape.top 644cdf0e10cSrcweir .column = myShape.Left 645cdf0e10cSrcweir 646cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 647cdf0e10cSrcweir .Values.Add myShape.name 648cdf0e10cSrcweir 649cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_NUMBERING_NOTE 650cdf0e10cSrcweir 651cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 652cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 653cdf0e10cSrcweir End With 654cdf0e10cSrcweir 655cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 656cdf0e10cSrcweir 657cdf0e10cSrcweirFinalExit: 658cdf0e10cSrcweir Set myIssue = Nothing 659cdf0e10cSrcweir Exit Sub 660cdf0e10cSrcweir 661cdf0e10cSrcweirHandleErrors: 662cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 663cdf0e10cSrcweir Resume FinalExit 664cdf0e10cSrcweirEnd Sub 665cdf0e10cSrcweir 666cdf0e10cSrcweirSub Analyze_Background(mySlide As Slide, myShape As Shape) 667cdf0e10cSrcweir On Error GoTo HandleErrors 668cdf0e10cSrcweir Dim currentFunctionName As String 669cdf0e10cSrcweir currentFunctionName = "Analyze_Background" 670cdf0e10cSrcweir 671cdf0e10cSrcweir If myShape.Fill.Type <> msoFillBackground Then Exit Sub 672cdf0e10cSrcweir 673cdf0e10cSrcweir Dim myIssue As IssueInfo 674cdf0e10cSrcweir Set myIssue = New IssueInfo 675cdf0e10cSrcweir Dim strCr As String 676cdf0e10cSrcweir strCr = "" & vbCr 677cdf0e10cSrcweir 678cdf0e10cSrcweir With myIssue 679cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 680cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 681cdf0e10cSrcweir .SubType = RID_RESXLS_COST_Background 682cdf0e10cSrcweir .Location = .CLocationSlide 683cdf0e10cSrcweir 684cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 685cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_BACKGROUND 686cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 687cdf0e10cSrcweir 688cdf0e10cSrcweir .SubLocation = mySlide.name 689cdf0e10cSrcweir .Line = myShape.top 690cdf0e10cSrcweir .column = myShape.Left 691cdf0e10cSrcweir 692cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 693cdf0e10cSrcweir .Values.Add myShape.name 694cdf0e10cSrcweir 695cdf0e10cSrcweir AddIssueDetailsNote myIssue, 0, RID_STR_PP_SUBISSUE_BACKGROUND_NOTE 696cdf0e10cSrcweir 697cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 698cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 699cdf0e10cSrcweir End With 700cdf0e10cSrcweir 701cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 702cdf0e10cSrcweir 703cdf0e10cSrcweirFinalExit: 704cdf0e10cSrcweir Set myIssue = Nothing 705cdf0e10cSrcweir Exit Sub 706cdf0e10cSrcweir 707cdf0e10cSrcweirHandleErrors: 708cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 709cdf0e10cSrcweir Resume FinalExit 710cdf0e10cSrcweirEnd Sub 711cdf0e10cSrcweir 712cdf0e10cSrcweirSub Analyze_Comments(mySlide As Slide, myShape As Shape) 713cdf0e10cSrcweir On Error GoTo HandleErrors 714cdf0e10cSrcweir Dim currentFunctionName As String 715cdf0e10cSrcweir currentFunctionName = "Analyze_Comments" 716cdf0e10cSrcweir 717cdf0e10cSrcweir If myShape.Type <> msoComment Then Exit Sub 718cdf0e10cSrcweir 719cdf0e10cSrcweir Dim myIssue As IssueInfo 720cdf0e10cSrcweir Set myIssue = New IssueInfo 721cdf0e10cSrcweir Dim strCr As String 722cdf0e10cSrcweir strCr = "" & vbCr 723cdf0e10cSrcweir 724cdf0e10cSrcweir With myIssue 725cdf0e10cSrcweir .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES 726cdf0e10cSrcweir .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES 727cdf0e10cSrcweir .SubType = RID_STR_PP_SUBISSUE_COMMENT 728cdf0e10cSrcweir .Location = .CLocationSlide 729cdf0e10cSrcweir 730cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES 731cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_COMMENT 732cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 733cdf0e10cSrcweir 734cdf0e10cSrcweir .SubLocation = mySlide.name 735cdf0e10cSrcweir .Line = myShape.top 736cdf0e10cSrcweir .column = myShape.Left 737cdf0e10cSrcweir 738cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 739cdf0e10cSrcweir .Values.Add myShape.name 740cdf0e10cSrcweir .Attributes.Add RID_STR_PP_ATTRIBUTE_CONTENT 741cdf0e10cSrcweir .Values.Add Replace(myShape.TextFrame.TextRange.Text, strCr, "") 742cdf0e10cSrcweir 743cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _ 744cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1 745cdf0e10cSrcweir End With 746cdf0e10cSrcweir 747cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 748cdf0e10cSrcweir 749cdf0e10cSrcweirFinalExit: 750cdf0e10cSrcweir Set myIssue = Nothing 751cdf0e10cSrcweir Exit Sub 752cdf0e10cSrcweir 753cdf0e10cSrcweirHandleErrors: 754cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 755cdf0e10cSrcweir Resume FinalExit 756cdf0e10cSrcweirEnd Sub 757cdf0e10cSrcweirSub Analyze_Movie(mySlide As Slide, myShape As Shape) 758cdf0e10cSrcweir On Error GoTo HandleErrors 759cdf0e10cSrcweir Dim currentFunctionName As String 760cdf0e10cSrcweir currentFunctionName = "Analyze_Movie" 761cdf0e10cSrcweir 762cdf0e10cSrcweir If myShape.Type <> msoMedia Then Exit Sub 763cdf0e10cSrcweir If myShape.MediaType <> ppMediaTypeMovie Then Exit Sub 764cdf0e10cSrcweir 765cdf0e10cSrcweir Dim myIssue As IssueInfo 766cdf0e10cSrcweir Set myIssue = New IssueInfo 767cdf0e10cSrcweir 768cdf0e10cSrcweir With myIssue 769cdf0e10cSrcweir .IssueID = CID_OBJECTS_GRAPHICS_TEXTBOXES 770cdf0e10cSrcweir .IssueType = RID_STR_PP_ISSUE_OBJECTS_GRAPHICS_AND_TEXTBOXES 771cdf0e10cSrcweir .SubType = RID_STR_PP_SUBISSUE_MOVIE 772cdf0e10cSrcweir .Location = .CLocationSlide 773cdf0e10cSrcweir 774cdf0e10cSrcweir .IssueTypeXML = CSTR_ISSUE_OBJECTS_GRAPHICS_AND_TEXTBOXES 775cdf0e10cSrcweir .SubTypeXML = CSTR_SUBISSUE_MOVIE 776cdf0e10cSrcweir .locationXML = .CXMLLocationSlide 777cdf0e10cSrcweir 778cdf0e10cSrcweir .SubLocation = mySlide.name 779cdf0e10cSrcweir .Line = myShape.top 780cdf0e10cSrcweir .column = myShape.Left 781cdf0e10cSrcweir 782cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME 783cdf0e10cSrcweir .Values.Add myShape.name 784cdf0e10cSrcweir .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE 785cdf0e10cSrcweir .Values.Add myShape.LinkFormat.SourceFullName 786cdf0e10cSrcweir .Attributes.Add RID_STR_PP_ATTRIBUTE_PLAYONENTRY 787cdf0e10cSrcweir .Values.Add IIf(myShape.AnimationSettings.PlaySettings.PlayOnEntry, RID_STR_PP_TRUE, RID_STR_PP_FALSE) 788cdf0e10cSrcweir .Attributes.Add RID_STR_PP_ATTRIBUTE_LOOP 789cdf0e10cSrcweir .Values.Add IIf(myShape.AnimationSettings.PlaySettings.LoopUntilStopped, RID_STR_PP_TRUE, RID_STR_PP_FALSE) 790cdf0e10cSrcweir .Attributes.Add RID_STR_PP_ATTRIBUTE_REWIND 791cdf0e10cSrcweir .Values.Add IIf(myShape.AnimationSettings.PlaySettings.RewindMovie, RID_STR_PP_TRUE, RID_STR_PP_FALSE) 792cdf0e10cSrcweir 793cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_OBJECTS_GRAPHICS_TEXTBOXES) = _ 794cdf0e10cSrcweir mAnalysis.IssuesCountArray(CID_OBJECTS_GRAPHICS_TEXTBOXES) + 1 795cdf0e10cSrcweir End With 796cdf0e10cSrcweir 797cdf0e10cSrcweir mAnalysis.Issues.Add myIssue 798cdf0e10cSrcweir 799cdf0e10cSrcweirFinalExit: 800cdf0e10cSrcweir Set myIssue = Nothing 801cdf0e10cSrcweir Exit Sub 802cdf0e10cSrcweir 803cdf0e10cSrcweirHandleErrors: 804cdf0e10cSrcweir WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source 805cdf0e10cSrcweir Resume FinalExit 806cdf0e10cSrcweirEnd Sub 807cdf0e10cSrcweir 808cdf0e10cSrcweirPrivate Sub Class_Initialize() 809cdf0e10cSrcweir Set mAnalysis = New DocumentAnalysis 810cdf0e10cSrcweirEnd Sub 811cdf0e10cSrcweirPrivate Sub Class_Terminate() 812cdf0e10cSrcweir Set mAnalysis = Nothing 813cdf0e10cSrcweirEnd Sub 814cdf0e10cSrcweir 815cdf0e10cSrcweirPublic Property Get Results() As DocumentAnalysis 816cdf0e10cSrcweir Set Results = mAnalysis 817cdf0e10cSrcweirEnd Property 818cdf0e10cSrcweir 819