Concept-Maket/src/CD_Audit.bas

Attribute VB_Name = "CD_Audit"
Option Private Module
Option Explicit

Private Const RUN_HEADER_RUN$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Private Const DANG_SPACES$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Private Const DANG_DASH$ = "<22><><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Private Const DANG_FLD$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>"
Private Const DANG_LISTNUM$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"
Private Const DANG_PICT$ = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>"

Public Sub CDA_Audit()
  Dim theDoc As Word.Document: Set theDoc = ActiveDocument
  Call CDD_RunAudit.Init
  Call CDD_RunAudit.Show
  If CDD_RunAudit.isCancelled_ Or CDD_RunAudit.CountRules = 0 Then _
    Exit Sub
  
  Call CSE_ProgressBar.Init("<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>", maxVal:=CDD_RunAudit.CountRules)
  Call CSE_ProgressBar.ShowModeless

  Dim sMessage$
  If CDD_RunAudit.DoHeaders Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & CheckHeaders(theDoc) & vbNewLine
  If CDD_RunAudit.DoPar Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & CheckSpaces(theDoc) & vbNewLine
  If CDD_RunAudit.DoDash Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & CheckDashes(theDoc) & vbNewLine
  If CDD_RunAudit.DoFields Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>: " & CheckFields(theDoc) & vbNewLine
  If CDD_RunAudit.DoListNums Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:" & CheckNumerList(theDoc) & vbNewLine
  If CDD_RunAudit.DoPict Then _
    sMessage = sMessage & "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>:" & CheckPict(theDoc) & vbNewLine
  
  Call Unload(CDD_RunAudit)
  Call Unload(CSE_ProgressBar)
  Call MsgBox(sMessage, vbInformation)
End Sub

' ===========
Private Function CheckNumerList(target As Word.Document) As Long
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, target.ListParagraphs.Count)
  
  Dim para As Word.Paragraph
  For Each para In target.ListParagraphs
    Dim theRange As Word.Range: Set theRange = para.Range
    If Not theRange.ListFormat.ListString Like "*#*" Or IsHeader(theRange) Then _
      GoTo NEXT_PARA

    Dim theLvl&: theLvl = theRange.ListFormat.ListLevelNumber
    If InStr(theRange, Chr(7)) Then _
      GoTo NEXT_PARA
    
    Dim prevRange As Word.Range: Set prevRange = theRange.Previous(wdParagraph)
    If CheckPrevRangeList(prevRange, theLvl) Then _
      GoTo NEXT_PARA
      
    If theRange.ListFormat.ListValue <> 1 Then
      Call theRange.Collapse(wdCollapseStart)
      Call theRange.Comments.Add(theRange, DANG_LISTNUM)
      CheckNumerList = CheckNumerList + 1
    End If

NEXT_PARA:
    Call CSE_ProgressBar.IncrementB
  Next para

  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
End Function

Private Function CheckPrevRangeList(prevRange As Word.Range, theLvl&) As Boolean
  CheckPrevRangeList = False
  
  If prevRange Is Nothing Then _
    Exit Function
  If IsHeader(prevRange) Or prevRange.ListFormat.List Is Nothing Then _
    Exit Function

  CheckPrevRangeList = theLvl <= prevRange.ListFormat.ListLevelNumber
End Function

Private Function CheckHeaders(target As Word.Document) As Long
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, target.Range.End)
  
  Dim parRng As Word.Range: Set parRng = target.Paragraphs.First.Range
  Do While Not parRng Is Nothing
    If Not IsHeader(parRng) Or IsHeader(parRng, 1) Then _
      GoTo NEXT_PAR
        
    If IsFirstInColumn(parRng) Then
      If parRng.ParagraphFormat.SpaceBefore <> 0 Then
        Call parRng.Comments.Add(parRng, RUN_HEADER_RUN)
        CheckHeaders = CheckHeaders + 1
      End If
    ElseIf parRng.ParagraphFormat.SpaceBefore <> 0 Then
      GoTo NEXT_PAR
    ElseIf Not IsHeader(parRng.Previous(wdParagraph)) Then
      Call parRng.Comments.Add(parRng, RUN_HEADER_RUN)
      CheckHeaders = CheckHeaders + 1
    End If
NEXT_PAR:
    Call CSE_ProgressBar.SetB(parRng.End)
    Set parRng = parRng.Next(wdParagraph, 1)
  Loop
  
  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
End Function

Private Function CheckSpaces(target As Word.Document) As Long
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, target.Range.End)
  
  Dim parRng As Word.Range: Set parRng = target.Paragraphs.First.Range
  Do While Not parRng Is Nothing
    If Not IsHeader(parRng) Or IsHeader(parRng, 1) Then _
      GoTo NEXT_PAR
    If IsFirstInColumn(parRng) Then _
      GoTo NEXT_PAR
    
    Dim tmpRng As Word.Range: Set tmpRng = parRng.Previous(wdParagraph)
    '<27><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD>
    If IsHeader(tmpRng) And tmpRng.ParagraphFormat.SpaceAfter = 0 Then
      Call parRng.Comments.Add(parRng, DANG_SPACES)
      CheckSpaces = CheckSpaces + 1
    End If
    
    '<27><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> ?<3F><><EFBFBD><EFBFBD><EFBFBD>?
    If Not IsHeader(tmpRng) And tmpRng.ParagraphFormat.SpaceAfter <> 0 Then
      If tmpRng.ListFormat.List Is Nothing Then
        Call parRng.Comments.Add(parRng, DANG_SPACES)
        CheckSpaces = CheckSpaces + 1
      End If
    End If
    
    ' <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> ?<3F><><EFBFBD><EFBFBD><EFBFBD>?
    Set tmpRng = parRng.Next(wdParagraph)
    If tmpRng.ParagraphFormat.SpaceBefore <> 0 Then
      Call parRng.Comments.Add(parRng, DANG_SPACES)
      CheckSpaces = CheckSpaces + 1
    End If
NEXT_PAR:
    Call CSE_ProgressBar.SetB(parRng.End)
    Set parRng = parRng.Next(wdParagraph, 1)
  Loop
  
  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
End Function

Private Function CheckPict(target As Word.Document) As Long
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, target.Shapes.Count)
  
  Dim aShape As Word.Shape
  For Each aShape In target.Shapes
    If aShape.Type = msoTextBox Then
      If GetColumn(aShape.Anchor) = T_COL_RIGHT And IsFirstInColumn(aShape.Anchor) Then
        Call aShape.Anchor.Comments.Add(aShape.Anchor, DANG_PICT)
        CheckPict = CheckPict + 1
      End If
    End If
    Call CSE_ProgressBar.IncrementB
  Next aShape
  
  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
End Function

Private Function CheckDashes(target As Word.Document) As Long
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, 3)
  
  Dim rFind As Word.Range: Set rFind = target.Range.Duplicate
  Dim tempRange As Word.Range
  With rFind.Find
    .Text = Chr(45)
    Do While .Execute
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseStart)
      Call tempRange.Select
      If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
        rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
        GoTo skp1
      End If
      
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseEnd)
      Call tempRange.Select
      If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
          PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
          rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
      End If
skp1:
    Loop
  End With
  Call CSE_ProgressBar.IncrementB
  
  Set rFind = target.Range.Duplicate
  With rFind.Find
    .Text = Chr(150)
    Do While .Execute
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseStart)
      Call tempRange.Select
      If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
          rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
        GoTo skp2
      End If
      
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseEnd)
      Call tempRange.Select
      If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
          PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
          rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
      End If
skp2:
    Loop
  End With
  Call CSE_ProgressBar.IncrementB
  
  Set rFind = target.Range.Duplicate
  With rFind.Find
    .Text = Chr(151)
    Do While .Execute
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseStart)
      Call tempRange.Select
      If PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 And _
          rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
        GoTo skp3
      End If
      
      Set tempRange = rFind.Duplicate
      Call tempRange.Collapse(wdCollapseEnd)
      Call tempRange.Select
      If (PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) < 0.1 Or _
          PointsToCentimeters(Selection.Information(wdHorizontalPositionRelativeToTextBoundary)) > 7.4) And _
          rFind.Comments.Count = 0 And rFind.Hyperlinks.Count = 0 And Not IsHeader(rFind) Then
        Call rFind.Comments.Add(rFind, DANG_DASH)
        CheckDashes = CheckDashes + 1
      End If
skp3:
    Loop
  End With
  Call CSE_ProgressBar.IncrementB
  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
End Function

Private Function CheckFields(target As Word.Document) As Long
  Dim tmp As Boolean: tmp = target.TrackRevisions
  target.TrackRevisions = False
  
  CSE_ProgressBar.Header = "<22><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>..."
  Call CSE_ProgressBar.InitSecondBar(0, target.Fields.Count)

  Dim aField As Word.Field
  For Each aField In target.Fields
    If aField.Update = False Then
      If aField.result.Font.Hidden = False Then
        CheckFields = CheckFields + 1
        Call aField.result.Comments.Add(aField.result, DANG_FLD)
      End If
    End If
    Call CSE_ProgressBar.IncrementB
  Next aField
  
  Call CSE_ProgressBar.HideSecondBar
  Call CSE_ProgressBar.IncrementA
  
  target.TrackRevisions = tmp
End Function