diff options
Diffstat (limited to 'migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls')
| -rw-r--r-- | migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls | 1522 |
1 files changed, 0 insertions, 1522 deletions
diff --git a/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls b/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls deleted file mode 100644 index da95587..0000000 --- a/migrationanalysis/src/driver_docs/sources/word/MigrationAnalyser.cls +++ /dev/null @@ -1,1522 +0,0 @@ -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
-
-'Class variables
-Private Enum HFIssueType
- hfInline
- hfShape
- hfFrame
-End Enum
-
-Private Enum HFIssueLocation
- hfHeader
- hffooter
-End Enum
-
-
-Private Type ShapeInfo
- top As Single
- Height As Single
-End Type
-
-Private Type FrameInfo
- Height As Single
- VerticalPosition As Single
-End Type
-
-Private mAnalysis As DocumentAnalysis
-Private mOdd As Boolean
-Private mbFormFieldErrorLogged As Boolean
-Private mbRefFormFieldErrorLogged As Boolean
-
-'***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:
-' word_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
-
- 'Only put this in if you have a preparation function added for this issue in CommonPreparation
- 'or Preparation - NUll can be replaced with any variant if you want to pass info to the Prepare fnc
- Call DoPreparation(mAnalysis, myIssue, "", Null, Null)
-
- 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"
- mAnalysis.name = fileName
- Dim aDoc As Document
- Dim bUnprotectError As Boolean
- mAnalysis.TotalIssueTypes = CTOTAL_CATEGORIES
- mbFormFieldErrorLogged = False
- mbRefFormFieldErrorLogged = False
-
- 'Turn off any AutoExce macros before loading the Word doc
- On Error Resume Next ' Ignore errors on setting
- WordBasic.DisableAutoMacros 1
- On Error GoTo HandleErrors
-
- Dim myPassword As String
- myPassword = GetDefaultPassword
-
- 'Always skip password protected documents
- 'If IsSkipPasswordDocs() Then
- Dim aPass As String
- If myPassword <> "" Then
- aPass = myPassword
- Else
- aPass = "xoxoxoxoxo"
- End If
-
- On Error Resume Next
- Set aDoc = Documents.Open(fileName, False, False, False, _
- aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _
- msoEncodingAutoDetect, False)
- If Err.Number = 5408 Then
- ' if password protected, try open readonly next
- Set aDoc = Documents.Open(fileName, False, True, False, _
- aPass, aPass, False, aPass, aPass, wdOpenFormatAuto, _
- msoEncodingAutoDetect, False)
- End If
- If Err.Number = 5408 Then
- HandleProtectedDocInvalidPassword mAnalysis, _
- "User entered Invalid Document Password, further analysis not possible", fso
- Analyze_Password_Protection True, False
- GoTo FinalExit
- ElseIf (Err.Number <> 0) Then
- GoTo HandleErrors
- End If
-
- On Error GoTo HandleErrors
-
- If aDoc Is Nothing Then GoTo FinalExit
-
- 'Do Analysis
- Analyze_Password_Protection aDoc.HasPassword, aDoc.WriteReserved
- Analyze_Document_Protection aDoc
-
- If aDoc.ProtectionType <> wdNoProtection Then
- If myPassword <> "" Then
- aDoc.Unprotect (myPassword)
- Else
- aDoc.Unprotect
- End If
- End If
-
- 'Set Doc Properties
- SetDocProperties mAnalysis, aDoc, fso
-
-ContinueFromUnprotectError:
-
- Analyze_Tables_TablesInTables aDoc
- Analyze_Tables_Borders aDoc
- Analyze_TOA aDoc
- If Not bUnprotectError Then
- Analyze_FieldAndFormFieldIssues aDoc
- End If
- Analyze_OLEEmbedded aDoc
- Analyze_MailMerge_DataSource aDoc
- Analyze_Macros mAnalysis, userFormTypesDict, aDoc
- 'Analyze_Numbering aDoc, mAnalysis
- 'Analyze_NumberingTabs aDoc, mAnalysis
-
- ' Doc Preparation only
- ' Save document with any prepared 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
- aDoc.SaveAs preparedFullPath
- End If
- End If
- End If
-
- 'DebugMacroInfo
-
-FinalExit:
-
- If Not aDoc Is Nothing Then 'If Not IsEmpty(aDoc) Then
- aDoc.Close (False)
- End If
- Set aDoc = Nothing
-
- Exit Sub
-
-HandleErrors:
- ' MsgBox currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- ' Handle Password error on Doc Open, Modify and Cancel
- If Err.Number = 5408 Or Err.Number = 4198 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
- ElseIf Err.Number = 5485 Then
- ' Handle Password error on Unprotect Doc
- WriteDebug currentFunctionName & " : " & fileName & ": " & _
- "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & _
- "Forms, Comments, Headers & Footers and Table cell spanning issues - " & Err.Number & " " & Err.Description & " " & Err.Source
- HandleProtectedDocInvalidPassword mAnalysis, _
- "User entered Invalid Document Part Password, Analysis of doc will continue but will skip analysis of:" & vbLf & _
- "Forms, Comments, Headers & Footers and Table cell spanning issues", fso
- bUnprotectError = True
- 'wdAllowOnlyComments, wdAllowOnlyFormFields, wdAllowOnlyRevisions
- Resume ContinueFromUnprotectError
- End If
- mAnalysis.Application = RID_STR_COMMON_CANNOT_OPEN
- WriteDebug currentFunctionName & " : " & fileName & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub DebugMacroInfo()
- MsgBox "TotalNumLines: " & mAnalysis.MacroTotalNumLines & vbLf & _
- "NumUserForms: " & mAnalysis.MacroNumUserForms & vbLf & _
- "NumUserFormControls: " & mAnalysis.MacroNumUserFormControls & vbLf & _
- "NumUserFormControlTypes: " & mAnalysis.MacroNumUserFormControlTypes & vbLf & _
- "NumExternalRefs: " & mAnalysis.MacroNumExternalRefs & vbLf & _
- "MacroNumFieldsUsingMacros: " & mAnalysis.MacroNumFieldsUsingMacros & vbLf & _
- "NumOLEControls: " & mAnalysis.MacroNumOLEControls & vbLf & _
- "MacroOverallClass: " & getDocOverallMacroClassAsString(mAnalysis.MacroOverallClass)
-End Sub
-
-Sub SetDocProperties(docAnalysis As DocumentAnalysis, doc As Document, fso As FileSystemObject)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "SetProperties"
- Dim f As File
- Set f = fso.GetFile(docAnalysis.name)
-
- docAnalysis.PageCount = doc.ComputeStatistics(wdStatisticPages)
- docAnalysis.Accessed = f.DateLastAccessed
-
- On Error Resume Next 'Some apps may not support all props
- docAnalysis.Application = getAppSpecificApplicationName & " " & Application.Version
- 'docAnalysis.Application = doc.BuiltinDocumentProperties(wdPropertyAppName)
- '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.Created = _
- doc.BuiltInDocumentProperties(wdPropertyTimeCreated)
- docAnalysis.Modified = _
- doc.BuiltInDocumentProperties(wdPropertyTimeLastSaved)
- docAnalysis.Printed = _
- doc.BuiltInDocumentProperties(wdPropertyTimeLastPrinted)
- docAnalysis.SavedBy = _
- doc.BuiltInDocumentProperties(wdPropertyLastAuthor)
- docAnalysis.Revision = _
- val(doc.BuiltInDocumentProperties(wdPropertyRevision))
- docAnalysis.Template = _
- fso.GetFileName(doc.BuiltInDocumentProperties(wdPropertyTemplate))
-
-FinalExit:
- Set f = Nothing
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-'Limitation: Detect first level table in tables, does not detect further nesting
-'Can do so if required
-Sub Analyze_Tables_TablesInTables(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_Tables_TablesInTables"
- Dim myTopTable As Table
- Dim myInnerTable As Table
- Dim myIssue As IssueInfo
-
- For Each myTopTable In currDoc.Tables
- For Each myInnerTable In myTopTable.Tables
- Dim logString As String
- Dim myRng As Range
- Dim startpage As Long
- Dim startRow As Long
- Dim StartColumn As Long
- Dim details As String
-
- Set myIssue = New IssueInfo
- Set myRng = myInnerTable.Range
- myRng.start = myRng.End
- startpage = myRng.Information(wdActiveEndPageNumber)
- startRow = myRng.Information(wdStartOfRangeRowNumber)
- StartColumn = myRng.Information(wdStartOfRangeColumnNumber)
-
- With myIssue
- .IssueID = CID_TABLES
- .IssueType = RID_STR_WORD_ISSUE_TABLES
- .SubType = RID_STR_WORD_SUBISSUE_NESTED_TABLES
- .Location = .CLocationPage
- .SubLocation = startpage
-
- .IssueTypeXML = CSTR_ISSUE_TABLES
- .SubTypeXML = CSTR_SUBISSUE_NESTED_TABLES
- .locationXML = .CXMLLocationPage
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_OUTER_TABLE
- .Values.Add myTopTable.Rows.count & "x" & myTopTable.Columns.count
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_INNER_TABLE
- .Values.Add myInnerTable.Rows.count & "x" & myInnerTable.Columns.count
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_ROW
- .Values.Add startRow
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_START_COL
- .Values.Add StartColumn
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NESTED_TABLE_WILL_BE_LOST
-
- mAnalysis.IssuesCountArray(CID_TABLES) = _
- mAnalysis.IssuesCountArray(CID_TABLES) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- Set myRng = Nothing
- Next
- Next
- Exit Sub
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
-End Sub
-
-Sub Analyze_Document_Protection(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_Document_Protection"
- If currDoc.ProtectionType = wdNoProtection Then
- Exit Sub
- End If
-
- 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_COMMON_SUBISSUE_DOCUMENT_PARTS_PROTECTION
- .Location = .CLocationDocument
-
- .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
- .SubTypeXML = CSTR_SUBISSUE_DOCUMENT_PARTS_PROTECTION
- .locationXML = .CXMLLocationDocument
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_PROTECTION
- Select Case currDoc.ProtectionType
- Case wdAllowOnlyComments
- .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_COMMENTS
- Case wdAllowOnlyFormFields
- .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_FORM_FIELDS
- Case wdAllowOnlyRevisions
- .Values.Add RID_STR_WORD_ATTRIBUTE_ALLOW_ONLY_REVISIONS
- Case Else
- .Values.Add RID_STR_COMMON_ATTRIBUTE_UNKNOWN
- End Select
-
- 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_Password_Protection(bHasPassword As Boolean, bWriteReserved As Boolean)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_Password_Protection"
- Dim myIssue As IssueInfo
-
- If bHasPassword Or bWriteReserved Then
- Set myIssue = New IssueInfo
-
- With myIssue
- .IssueID = CID_CONTENT_AND_DOCUMENT_PROPERTIES
- .IssueType = RID_STR_COMMON_ISSUE_CONTENT_AND_DOCUMENT_PROPERTIES
- .SubType = RID_STR_COMMON_SUBISSUE_PASSWORDS_PROTECTION
- .Location = .CLocationDocument
-
- .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
- .SubTypeXML = CSTR_SUBISSUE_PASSWORDS_PROTECTION
- .locationXML = .CXMLLocationDocument
-
- If bHasPassword Then
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_OPEN
- .Values.Add RID_STR_WORD_ATTRIBUTE_SET
- End If
- If bWriteReserved Then
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_PASSWORD_TO_MODIFY
- .Values.Add RID_STR_WORD_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 Analyze_OLEEmbedded(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_OLEEmbedded"
-
- ' Handle Inline Shapes
- Dim aILShape As InlineShape
- For Each aILShape In currDoc.InlineShapes
- Analyze_OLEEmbeddedSingleInlineShape aILShape
- Next aILShape
-
- ' Handle Shapes
- Dim aShape As Shape
- For Each aShape In currDoc.Shapes
- Analyze_OLEEmbeddedSingleShape mAnalysis, aShape, _
- Selection.Information(wdActiveEndPageNumber)
- Analyze_Lines mAnalysis, aShape, _
- Selection.Information(wdActiveEndPageNumber)
- Analyze_Transparency mAnalysis, aShape, _
- Selection.Information(wdActiveEndPageNumber)
- Analyze_Gradients mAnalysis, aShape, _
- Selection.Information(wdActiveEndPageNumber)
- Next aShape
-
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
-End Sub
-
-
-'WdInlineShapeType constants:
-'wdInlineShapeEmbeddedOLEObject, wdInlineShapeHorizontalLine, wdInlineShapeLinkedOLEObject,
-'wdInlineShapeLinkedPicture, wdInlineShapeLinkedPictureHorizontalLine, wdInlineShapeOLEControlObject,
-'wdInlineShapeOWSAnchor, wdInlineShapePicture, wdInlineShapePictureBullet,
-'wdInlineShapePictureHorizontalLine, wdInlineShapeScriptAnchor
-
-Sub Analyze_OLEEmbeddedSingleInlineShape(aILShape As InlineShape)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_OLEEmbeddedSingleInlineShape"
- Dim myIssue As IssueInfo
- Dim bOleObject As Boolean
- Dim TypeAsString As String
- Dim XMLTypeAsString As String
- Dim objName As String
-
- bOleObject = (aILShape.Type = wdInlineShapeEmbeddedOLEObject) Or _
- (aILShape.Type = wdInlineShapeLinkedOLEObject) Or _
- (aILShape.Type = wdInlineShapeOLEControlObject)
-
- If Not bOleObject Then Exit Sub
-
- aILShape.Select
- Select Case aILShape.Type
- Case wdInlineShapeOLEControlObject
- TypeAsString = RID_STR_COMMON_OLE_CONTROL
- XMLTypeAsString = CSTR_SUBISSUE_OLE_CONTROL
- Case wdInlineShapeEmbeddedOLEObject
- TypeAsString = RID_STR_COMMON_OLE_EMBEDDED
- XMLTypeAsString = CSTR_SUBISSUE_OLE_EMBEDDED
- Case wdInlineShapeLinkedOLEObject
- TypeAsString = RID_STR_COMMON_OLE_LINKED
- XMLTypeAsString = CSTR_SUBISSUE_OLE_LINKED
- Case Else
- TypeAsString = RID_STR_COMMON_OLE_UNKNOWN
- XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN
- End Select
-
- Set myIssue = New IssueInfo
- With myIssue
- .IssueID = CID_PORTABILITY
- .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY
- .SubType = TypeAsString
- .Location = .CLocationPage
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
-
- .IssueTypeXML = CSTR_ISSUE_PORTABILITY
- .SubTypeXML = XMLTypeAsString
- .locationXML = .CXMLLocationPage
-
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
-
- DoEvents
- If aILShape.Type = wdInlineShapeEmbeddedOLEObject Or _
- aILShape.Type = wdInlineShapeOLEControlObject Then
-
- 'If Object is invalid can get automation server hanging
- Dim tmpStr As String
- On Error Resume Next
- tmpStr = aILShape.OLEFormat.Object
- If Err.Number = 0 Then
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
- .Values.Add aILShape.OLEFormat.ProgID
- Else
- Err.Clear
- tmpStr = aILShape.OLEFormat.ClassType
- If Err.Number = 0 Then
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
- .Values.Add aILShape.OLEFormat.ClassType
- Else
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
- .Values.Add RID_STR_COMMON_NA
- End If
- End If
-
- If aILShape.Type = wdInlineShapeOLEControlObject Then
- mAnalysis.MacroNumOLEControls = 1 + mAnalysis.MacroNumOLEControls
- End If
-
- objName = aILShape.OLEFormat.Object.name
- If Err.Number = 0 Then
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_NAME
- .Values.Add objName
- End If
- On Error GoTo HandleErrors
- End If
- If aILShape.Type = wdInlineShapeLinkedOLEObject Then
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_SOURCE
- .Values.Add aILShape.LinkFormat.SourceFullName
- End If
-
- mAnalysis.IssuesCountArray(CID_PORTABILITY) = _
- mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
-
-FinalExit:
- Set myIssue = Nothing
- Exit Sub
-
-HandleErrors:
- WriteDebugLevelTwo currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-'Appears to be picked up by other OLE analysis code - the Shapes are actually field codes
-'So I get double reporting if I use this as well.
-Sub Analyze_OLEFields(myField As Field)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_OLEFields"
- Dim myIssue As IssueInfo
- Dim bOleObject As Boolean
- Dim TypeAsString As String
- Dim XMLTypeAsString As String
-
- bOleObject = (myField.Type = wdFieldOCX)
-
- If Not bOleObject Then Exit Sub
-
- myField.Select
- Select Case myField.Type
- Case wdFieldLink
- TypeAsString = RID_STR_COMMON_OLE_FIELD_LINK
- XMLTypeAsString = CSTR_SUBISSUE_OLE_FIELD_LINK
- Case Else
- TypeAsString = RID_STR_COMMON_OLE_UNKNOWN
- XMLTypeAsString = CSTR_SUBISSUE_OLE_UNKNOWN
- End Select
- Set myIssue = New IssueInfo
- With myIssue
- .IssueID = CID_PORTABILITY
- .IssueType = RID_STR_COMMON_ISSUE_PORTABILITY
- .SubType = TypeAsString
- .Location = .CLocationPage
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
-
- .IssueTypeXML = CSTR_ISSUE_PORTABILITY
- .SubTypeXML = XMLTypeAsString
- .locationXML = .CXMLLocationPage
-
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_OBJECT_TYPE
- .Values.Add myField.OLEFormat.ClassType
-
- If myField.Type = wdFieldLink Then
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_LINK
- .Values.Add myField.LinkFormat.SourceFullName
- End If
- mAnalysis.IssuesCountArray(CID_PORTABILITY) = _
- mAnalysis.IssuesCountArray(CID_PORTABILITY) + 1
- End With
- mAnalysis.Issues.Add myIssue
-
- Set myIssue = Nothing
-
- Exit Sub
-
-HandleErrors:
- Set myIssue = Nothing
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
-End Sub
-
-Sub Analyze_MailMergeField(myField As Field)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_MailMergeField"
- Dim myIssue As IssueInfo
- Dim TypeAsString As String
- Dim bProblemMailMergeField As Boolean
-
- bProblemMailMergeField = _
- (myField.Type = wdFieldFillIn) Or _
- (myField.Type = wdFieldAsk) Or _
- (myField.Type = wdFieldMergeRec) Or _
- (myField.Type = wdFieldMergeField) Or _
- (myField.Type = wdFieldNext) Or _
- (myField.Type = wdFieldRevisionNum) Or _
- (myField.Type = wdFieldSequence) Or _
- (myField.Type = wdFieldAutoNum) Or _
- (myField.Type = wdFieldAutoNumOutline) Or _
- (myField.Type = wdFieldAutoNumLegal)
-
- If bProblemMailMergeField Then
- 'Some of the following are numbering fields and need to be broken out into a seperate function. See migration guide.
-
- Select Case myField.Type
- Case wdFieldFillIn
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FILL_IN
- Case wdFieldAsk
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_ASK
- Case wdFieldMergeRec
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_RECORDS
- Case wdFieldMergeField
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_MERGE_FIELDS
- Case wdFieldNext
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_NEXT
- Case wdFieldRevisionNum
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_REVISION_NUMBER
- Case wdFieldSequence
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_SEQUENCE
- Case wdFieldAutoNum
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER
- Case wdFieldAutoNumOutline
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_OUTLINE
- Case wdFieldAutoNumLegal
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_AUTO_NUMBER_LEGAL
- Case Else
- TypeAsString = RID_STR_WORD_ENUMERATION_MAILMERGE_FIELD_NAME_NOT_KNOWN
- End Select
-
- Set myIssue = New IssueInfo
- myField.Select
- With myIssue
- .IssueID = CID_FIELDS
- .IssueType = RID_STR_WORD_ISSUE_FIELDS
- .SubType = RID_STR_WORD_SUBISSUE_MAILMERGE_FIELD
- .Location = .CLocationPage
-
- .IssueTypeXML = CSTR_ISSUE_FIELDS
- .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_FIELD
- .locationXML = .CXMLLocationPage
-
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
-
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
- .Values.Add TypeAsString
- If myField.Code.Text <> "" Then
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_TEXT
- .Values.Add myField.Code.Text
- End If
-
- mAnalysis.IssuesCountArray(CID_FIELDS) = _
- mAnalysis.IssuesCountArray(CID_FIELDS) + 1
- End With
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
-End Sub
-
-'Get field DS Info
-Sub Analyze_MailMerge_DataSource(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_MailMerge_DataSource"
- ' There may be no mail merge in the document
- If (currDoc.MailMerge.DataSource.Type = wdNoMergeInfo) Then
- Exit Sub
- End If
-
- 'Dim issue As SimpleAnalysisInfo
- If (currDoc.MailMerge.DataSource.Type <> wdNoMergeInfo) Then
- 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_WORD_SUBISSUE_MAILMERGE_DATASOURCE
- .Location = .CLocationDocument
-
- .IssueTypeXML = CSTR_ISSUE_CONTENT_DOCUMENT_PROPERTIES
- .SubTypeXML = CSTR_SUBISSUE_MAILMERGE_DATASOURCE
- .locationXML = .CXMLLocationDocument
-
- .Attributes.Add RID_STR_COMMON_ATTRIBUTE_NAME
- .Values.Add currDoc.MailMerge.DataSource.name
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_DATASOURCE
- .Values.Add currDoc.MailMerge.DataSource.Type
-
- mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) = _
- mAnalysis.IssuesCountArray(CID_CONTENT_AND_DOCUMENT_PROPERTIES) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
-End Sub
-
-Function getFormFieldTypeAsString(fieldType As WdFieldType)
- Dim Str As String
-
- Select Case fieldType
- Case wdFieldFormCheckBox
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CHECK_BOX
- Case wdFieldFormDropDown
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DROP_DOWN
- Case wdFieldFormTextInput
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_TEXT
- Case Else
- Str = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- getFormFieldTypeAsString = Str
-End Function
-Function getTextFormFieldTypeAsString(fieldType As WdTextFormFieldType)
- Dim Str As String
-
- Select Case fieldType
- Case wdCalculationText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CALCULATION
- Case wdCurrentDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_DATE
- Case wdCurrentTimeText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_CURRENT_TIME
- Case wdDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DATE
- Case wdNumberText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_NUMBER
- Case wdRegularText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_REGULAR
- Case Else
- Str = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- getTextFormFieldTypeAsString = Str
-End Function
-Function getTextFormFieldDefaultAsString(fieldType As WdTextFormFieldType)
- Dim Str As String
-
- Select Case fieldType
- Case wdCalculationText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_EXPRESSION
- Case wdCurrentDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE
- Case wdCurrentTimeText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TIME
- Case wdDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_DATE
- Case wdNumberText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_NUMBER
- Case wdRegularText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_DEFAULT_TEXT
- Case Else
- Str = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- getTextFormFieldDefaultAsString = Str
-End Function
-Function getTextFormFieldFormatAsString(fieldType As WdTextFormFieldType)
- Dim Str As String
-
- Select Case fieldType
- Case wdCalculationText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER
- Case wdCurrentDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE
- Case wdCurrentTimeText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TIME
- Case wdDateText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_DATE
- Case wdNumberText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_NUMBER
- Case wdRegularText
- Str = RID_STR_WORD_ENUMERATION_FORM_FIELD_FORMAT_TEXT
- Case Else
- Str = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- getTextFormFieldFormatAsString = Str
-End Function
-
-Sub Analyze_FieldAndFormFieldIssues(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_FormFields"
- Dim myIssue As IssueInfo
-
- 'Analysze all Fields in doc
- Dim myField As Field
-
- For Each myField In currDoc.Fields
- 'Analyze Mail Merge Fields
- Analyze_MailMergeField myField
-
- 'Analyze TOA Fields
- Analyze_TOAField myField
- Next myField
-
- 'Analyze FormField doc issues
- If currDoc.FormFields.count = 0 Then GoTo FinalExit
-
- If (currDoc.FormFields.Shaded) Then
- Set myIssue = New IssueInfo
- With myIssue
- .IssueID = CID_FIELDS
- .IssueType = RID_STR_WORD_ISSUE_FIELDS
- .SubType = RID_STR_WORD_SUBISSUE_APPEARANCE
- .Location = .CLocationDocument
-
- .IssueTypeXML = CSTR_ISSUE_FIELDS
- .SubTypeXML = CSTR_SUBISSUE_APPEARANCE
- .locationXML = .CXMLLocationDocument
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_GREYED
- .Values.Add RID_STR_WORD_TRUE
- mAnalysis.IssuesCountArray(CID_FIELDS) = _
- mAnalysis.IssuesCountArray(CID_FIELDS) + 1
- End With
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
- 'Analyse all FormFields in doc
- Dim myFormField As FormField
-
- For Each myFormField In currDoc.FormFields
- Analyze_FormFieldIssue myFormField
- Next myFormField
-
-FinalExit:
- Set myIssue = Nothing
- Set myFormField = Nothing
- Exit Sub
-
-HandleErrors:
-
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub Analyze_FormFieldIssue(myFormField As FormField)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_FormFieldIssue"
- Dim myIssue As IssueInfo
- Dim bCheckBoxIssues As Boolean
- Dim bFormFieldIssues As Boolean
-
- bCheckBoxIssues = False
- If (myFormField.Type = wdFieldFormCheckBox) Then
- If myFormField.CheckBox.AutoSize Then
- bCheckBoxIssues = True
- End If
- End If
-
- bFormFieldIssues = bCheckBoxIssues
-
- If Not bFormFieldIssues Then GoTo FinalExit
-
- myFormField.Select
- Set myIssue = New IssueInfo
- With myIssue
- .IssueID = CID_FIELDS
- .IssueType = RID_STR_WORD_ISSUE_FIELDS
- .SubType = RID_STR_WORD_SUBISSUE_FORM_FIELD
- .Location = .CLocationPage
-
- .IssueTypeXML = CSTR_ISSUE_FIELDS
- .SubTypeXML = CSTR_SUBISSUE_FORM_FIELD
- .locationXML = .CXMLLocationPage
-
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
- myIssue.Attributes.Add RID_STR_COMMON_ATTRIBUTE_TYPE
- myIssue.Values.Add getFormFieldTypeAsString(myFormField.Type)
- End With
-
- 'Checkbox Issues
- If (myFormField.Type = wdFieldFormCheckBox) Then
- 'AutoSize CheckBoxes
- If myFormField.CheckBox.AutoSize Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_AUTOSIZE
- myIssue.Values.Add RID_STR_WORD_TRUE
- End If
- End If
-
- 'TextInput Issues
- If myFormField.Type = wdFieldFormTextInput Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_TEXT_FORM_FIELD_TYPE
- myIssue.Values.Add getTextFormFieldTypeAsString(myFormField.TextInput.Type)
- Dim bLostType As Boolean
- bLostType = False
- If (myFormField.TextInput.Type = wdCalculationText) Or _
- (myFormField.TextInput.Type = wdCurrentDateText) Or _
- (myFormField.TextInput.Type = wdCurrentTimeText) Then
- AddIssueDetailsNote myIssue, 0, getTextFormFieldTypeAsString(myFormField.TextInput.Type) & _
- " " & RID_STR_WORD_NOTE_FORM_FIELD_TYPE_LOST
- bLostType = True
- End If
-
- If (myFormField.TextInput.Format <> "") Then
- myIssue.Attributes.Add getTextFormFieldFormatAsString(myFormField.TextInput.Type)
- myIssue.Values.Add myFormField.TextInput.Format
- End If
-
- 'Default text
- If (myFormField.TextInput.Default <> "") Then
- myIssue.Attributes.Add getTextFormFieldDefaultAsString(myFormField.TextInput.Type)
- myIssue.Values.Add myFormField.TextInput.Default
- End If
-
- 'Maximum text
- If (myFormField.TextInput.Width <> 0) Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_MAX_LENGTH
- myIssue.Values.Add myFormField.TextInput.Width
- End If
-
- 'Fill-in disabled
- If (myFormField.Enabled = False) And (Not bLostType) Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_FILLIN_ENABLED
- myIssue.Values.Add RID_STR_WORD_FALSE
- End If
- End If
-
- 'Help Key(F1)
- If (myFormField.OwnHelp And myFormField.HelpText <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_OWN_TEXT
- myIssue.Values.Add myFormField.HelpText
- ElseIf ((Not myFormField.OwnHelp) And myFormField.HelpText <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_HELP_KEY_F1_AUTO_TEXT
- myIssue.Values.Add myFormField.HelpText
- End If
-
- 'StatusHelp
- If (myFormField.OwnStatus And myFormField.StatusText <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_OWN_TEXT
- myIssue.Values.Add myFormField.StatusText
- ElseIf ((Not myFormField.OwnStatus) And myFormField.StatusText <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_STATUS_BAR_HELP_AUTO_TEXT
- myIssue.Values.Add myFormField.StatusText
- End If
-
- 'Macros
- If (myFormField.EntryMacro <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_ENTRY_MACRO
- myIssue.Values.Add myFormField.EntryMacro
- End If
- If (myFormField.ExitMacro <> "") Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_EXIT_MACRO
- myIssue.Values.Add myFormField.ExitMacro
- End If
- If (myFormField.EntryMacro <> "") Or (myFormField.ExitMacro <> "") Then
- mAnalysis.MacroNumFieldsUsingMacros = 1 + mAnalysis.MacroNumFieldsUsingMacros
- End If
-
- 'LockedField
- If (myFormField.Enabled = False) And (myFormField.Type <> wdFieldFormTextInput) Then
- myIssue.Attributes.Add RID_STR_WORD_ATTRIBUTE_FORM_FIELD_LOCKED
- myIssue.Values.Add RID_STR_WORD_TRUE
- End If
-
- mAnalysis.IssuesCountArray(CID_FIELDS) = _
- mAnalysis.IssuesCountArray(CID_FIELDS) + 1
-
- mAnalysis.Issues.Add myIssue
-
-FinalExit:
- Set myIssue = Nothing
- Exit Sub
-
-HandleErrors:
- 'Log first occurence for this doc
- If Not mbFormFieldErrorLogged Then
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- mbFormFieldErrorLogged = True
- End If
- Resume FinalExit
-End Sub
-
-
-Sub Analyze_TOA(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_TOA"
-
- Dim toa As TableOfAuthorities
- Dim myIssue As IssueInfo
- Dim myRng As Range
-
- For Each toa In currDoc.TablesOfAuthorities
- Set myRng = toa.Range
- myRng.start = myRng.End
- Set myIssue = New IssueInfo
- myRng.Select
-
- Dim TabLeaderAsString As String
- Select Case toa.TabLeader
- Case wdTabLeaderDashes
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DASHES
- Case wdTabLeaderDots
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_DOTS
- Case wdTabLeaderHeavy
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_HEAVY
- Case wdTabLeaderLines
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_LINES
- Case wdTabLeaderMiddleDot
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_MIDDLEDOT
- Case wdTabLeaderSpaces
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_INDEX_LEADER_SPACES
- Case Else
- TabLeaderAsString = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- Dim FormatAsString As String
- Select Case currDoc.TablesOfAuthorities.Format
- Case wdTOAClassic
- FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_CLASSIC
- Case wdTOADistinctive
- FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_DISTINCTIVE
- Case wdTOAFormal
- FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FORMAL
- Case wdTOASimple
- FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_SIMPLE
- Case wdTOATemplate
- FormatAsString = RID_STR_WORD_ENUMERATION_INDEX_TABLES_FROM_TEMPLATE
- Case Else
- FormatAsString = RID_STR_WORD_ENUMERATION_UNKNOWN
- End Select
-
- With myIssue
- .IssueID = CID_INDEX_AND_REFERENCES
- .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
- .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES
- .Location = .CLocationPage
-
- .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
- .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES
- .locationXML = .CXMLLocationPage
-
- .SubLocation = myRng.Information(wdActiveEndPageNumber)
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_LEADER
- .Values.Add TabLeaderAsString
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_MIGRATE_AS_PLAIN_TEXT
-
- mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
- mAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- Set myRng = Nothing
- Next
-FinalExit:
- Set myIssue = Nothing
- Set myRng = Nothing
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub Analyze_TOAField(myField As Field)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_TOAField"
-
- Dim toa As TableOfAuthorities
- Dim myIssue As IssueInfo
-
- If myField.Type = wdFieldTOAEntry Then
- Set myIssue = New IssueInfo
- myField.Select
-
- With myIssue
- .IssueID = CID_FIELDS
- .IssueType = RID_STR_WORD_ISSUE_FIELDS
- .SubType = RID_STR_WORD_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD
- .Location = .CLocationPage
-
- .IssueTypeXML = CSTR_ISSUE_FIELDS
- .SubTypeXML = CSTR_SUBISSUE_TABLE_OF_AUTHORITIES_FIELD
- .locationXML = .CXMLLocationPage
-
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_FIELD_TEXT
- .Values.Add myField.Code.Text
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TOA_FIELD_LOST_ON_ROUNDTRIP
-
- mAnalysis.IssuesCountArray(CID_FIELDS) = _
- mAnalysis.IssuesCountArray(CID_FIELDS) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
-FinalExit:
- Set myIssue = Nothing
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Resume FinalExit
-End Sub
-
-Sub Analyze_Tables_Borders(currDoc As Document)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_Tables_Borders"
- Dim myIssue As IssueInfo
- Set myIssue = New IssueInfo
- Dim aTable As Table
- Dim invalidBorders As String
-
- For Each aTable In currDoc.Tables
- invalidBorders = GetInvalidBorder(aTable)
- If invalidBorders <> "" Then
- aTable.Range.Select
- Set myIssue = New IssueInfo
- With myIssue
- .IssueID = CID_TABLES
- .IssueType = RID_STR_WORD_ISSUE_TABLES
- .SubType = RID_STR_WORD_SUBISSUE_BORDER_STYLES
- .Location = .CLocationPage
-
- .IssueTypeXML = CSTR_ISSUE_TABLES
- .SubTypeXML = CSTR_SUBISSUE_BORDER_STYLES
- .locationXML = .CXMLLocationPage
-
- .SubLocation = Selection.Information(wdActiveEndPageNumber)
- .Line = Selection.Information(wdFirstCharacterLineNumber)
- .column = Selection.Information(wdFirstCharacterColumnNumber)
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_BORDERS_NOT_DISPLAYING
- .Values.Add invalidBorders
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_TABLE_BORDER
-
- mAnalysis.IssuesCountArray(CID_TABLES) = mAnalysis.IssuesCountArray(CID_TABLES) + 1
- End With
-
- mAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- 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
-Function GetInvalidBorder(aTable As Table) As String
-
- Dim theResult As String
- theResult = ""
-
- If IsInvalidBorderStyle(aTable.Borders(wdBorderTop).LineStyle) Then
- theResult = theResult + "Top, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderBottom).LineStyle) Then
- theResult = theResult + "Bottom, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalDown).LineStyle) Then
- theResult = theResult + "Down Diagonal, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderDiagonalUp).LineStyle) Then
- theResult = theResult + "Up Diagonal, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderHorizontal).LineStyle) Then
- theResult = theResult + "Horizontal, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderLeft).LineStyle) Then
- theResult = theResult + "Left, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderRight).LineStyle) Then
- theResult = theResult + "Right, "
- End If
- If IsInvalidBorderStyle(aTable.Borders(wdBorderVertical).LineStyle) Then
- theResult = theResult + "Vertical, "
- End If
-
- If theResult <> "" Then
- theResult = Left(theResult, (Len(theResult) - 2)) + "."
- End If
-
- GetInvalidBorder = theResult
-End Function
-
-Function IsInvalidBorderStyle(aStyle As WdLineStyle) As Boolean
-
- Dim IsInvalid As Boolean
-
- Select Case aStyle
- Case wdLineStyleDot, wdLineStyleDashSmallGap, wdLineStyleDashLargeGap, wdLineStyleDashDot, _
- wdLineStyleDashDotDot, wdLineStyleTriple, wdLineStyleThinThickThinSmallGap, wdLineStyleThinThickMedGap, _
- wdLineStyleThickThinMedGap, wdLineStyleThinThickThinMedGap, wdLineStyleThinThickLargeGap, _
- wdLineStyleThickThinLargeGap, wdLineStyleThinThickThinLargeGap, wdLineStyleSingleWavy, _
- wdLineStyleDoubleWavy, wdLineStyleDashDotStroked, wdLineStyleEmboss3D, wdLineStyleEngrave3D
- IsInvalid = True
- Case Else
- IsInvalid = False
- End Select
-
- IsInvalidBorderStyle = IsInvalid
-
-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
-
-Sub Analyze_NumberingTabs(currDoc As Document, docAnalysis As DocumentAnalysis)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_NumberingTabs"
-
- Dim tb As TabStop
- Dim customTabPos As Single
- Dim tabs As Integer
- Dim listLvl As Long
- Dim tp As Single
- Dim bHasAlignmentProblem As Boolean
- Dim bHasTooManyTabs As Boolean
- Dim myIssue As IssueInfo
- Dim p As Object
-
- bHasAlignmentProblem = False
- bHasTooManyTabs = False
-
- For Each p In currDoc.ListParagraphs
- tabs = 0
- For Each tb In p.TabStops
- If tb.customTab Then
- tabs = tabs + 1
- customTabPos = tb.Position
- End If
- Next
-
- If tabs = 1 Then
- listLvl = p.Range.ListFormat.ListLevelNumber
- tp = p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).TabPosition
- If (p.Range.ListFormat.ListTemplate.ListLevels.item(listLvl).Alignment <> _
- wdListLevelAlignLeft) Then
- ' ERROR: alignment problem
- bHasAlignmentProblem = True
- End If
-
- If tp <> customTabPos Then
- p.Range.InsertBefore ("XXXXX")
- End If
- 'OK - at least heuristically
- Else
- 'ERROR: too many tabs
- bHasTooManyTabs = True
- End If
- Next
-
- If (bHasAlignmentProblem) Then
- Set myIssue = New IssueInfo
-
- With myIssue
- .IssueID = CID_INDEX_AND_REFERENCES
- .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
- .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_ALIGNMENT
- .Location = .CLocationDocument 'Location string
-
- .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
- .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_ALIGNMENT
- .locationXML = .CXMLLocationDocument
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_ALIGNMENT
-
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
- End With
- docAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
- If (bHasTooManyTabs) Then
- Set myIssue = New IssueInfo
-
- With myIssue
- .IssueID = CID_INDEX_AND_REFERENCES
- .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
- .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_TAB_OVERFLOW
- .Location = .CLocationDocument 'Location string
-
- .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
- .SubTypeXML = CSTR_SUBISSUE_NUMBERING_TAB_OVERFLOW
- .locationXML = .CXMLLocationDocument
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_TAB_OVERFLOW
-
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
- End With
- docAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Set myIssue = Nothing
- Resume FinalExit
-End Sub
-
-Sub Analyze_Numbering(currDoc As Document, docAnalysis As DocumentAnalysis)
- On Error GoTo HandleErrors
- Dim currentFunctionName As String
- currentFunctionName = "Analyze_Numbering"
-
- Dim myIssue As IssueInfo
- Dim nFormatProblems As Integer
- Dim nAlignmentProblems As Integer
- nFormatProblems = 0
- nAlignmentProblems = 0
-
- Dim lt As ListTemplate
- Dim lvl As ListLevel
- Dim I, l_, p1, p2, v1, v2 As Integer
- Dim display_levels As Integer
- Dim fmt, prefix, postfix, res As String
-
- For Each lt In currDoc.ListTemplates
- l_ = 0
- For Each lvl In lt.ListLevels
- l_ = l_ + 1
- 'Selection.TypeText Text:="List Number Format " + lvl.NumberFormat
- 'Apply Heuristic
- fmt = lvl.NumberFormat
- p1 = InStr(fmt, "%")
- p2 = InStrRev(fmt, "%")
- v1 = val(Mid(fmt, p1 + 1, 1))
- v2 = val(Mid(fmt, p2 + 1, 1))
- display_levels = v2 - v1 + 1
- prefix = Mid(fmt, 1, p1 - 1)
- postfix = Mid(fmt, p2 + 2)
- 'Check Heuristic
- res = prefix
- For I = 2 To display_levels
- res = "%" + Trim(Str(l_ - I + 1)) + "." + res
- Next
- res = res + "%" + Trim(Str(l_)) + postfix
- If (StrComp(res, fmt) <> 0) Then
- nFormatProblems = nFormatProblems + 1
- 'Selection.TypeText Text:="Label Problem: NumberFormat=" + fmt + " Heuristic=" + res
- End If
-
- 'check alignment
- If (lvl.NumberPosition <> wdListLevelAlignLeft) Then
- nAlignmentProblems = nAlignmentProblems + 1
- 'Selection.TypeText Text:="Number alignment problem"
- End If
- Next
- Next
-
- If (nFormatProblems > 0) Then
- Set myIssue = New IssueInfo
-
- With myIssue
- .IssueID = CID_INDEX_AND_REFERENCES
- .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
- .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_FORMAT
- .Location = .CLocationDocument 'Location string
-
- .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
- .SubTypeXML = CSTR_SUBISSUE_NUMBERING_FORMAT
- .locationXML = .CXMLLocationDocument
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT
- .Values.Add nFormatProblems
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_FORMAT
-
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
- End With
- docAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
- If (nAlignmentProblems > 0) Then
- Set myIssue = New IssueInfo
-
- With myIssue
- .IssueID = CID_INDEX_AND_REFERENCES
- .IssueType = RID_STR_WORD_ISSUE_INDEX_AND_REFERENCES
- .SubType = RID_STR_WORD_SUBISSUE_NUMBERING_ALIGNMENT
- .Location = .CLocationDocument 'Location string
-
- .IssueTypeXML = CSTR_ISSUE_INDEX_AND_REFERENCES
- .SubTypeXML = CSTR_SUBISSUE_NUMBERING_ALIGNMENT
- .locationXML = .CXMLLocationDocument
-
- .Attributes.Add RID_STR_WORD_ATTRIBUTE_COUNT
- .Values.Add nAlignmentProblems
-
- AddIssueDetailsNote myIssue, 0, RID_STR_WORD_NOTE_NUMBERING_ALIGNMENT
-
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) = _
- docAnalysis.IssuesCountArray(CID_INDEX_AND_REFERENCES) + 1
- End With
- docAnalysis.Issues.Add myIssue
- Set myIssue = Nothing
- End If
-
-FinalExit:
- Exit Sub
-
-HandleErrors:
- WriteDebug currentFunctionName & " : " & mAnalysis.name & ": " & Err.Number & " " & Err.Description & " " & Err.Source
- Set myIssue = Nothing
- Resume FinalExit
-End Sub
-
|