'
' Technical Specification Formatting Script
' Version: 1.13
'
Sub FormattingTechSpec()
    Dim table As table
    Dim c As Word.Cell
    Dim table_counter As Integer
    Dim table_max As Integer
    Dim table_max_cell As Long
    Dim table_actual As Integer
    Dim table_actual_cell As Long
    Dim counter As Integer
    Dim color As Long
    Dim bold As Boolean
    Dim LeftCharASCII As Integer

  ' Begin of MetaData Integration
    Dim PropertyConsultant As String
    Dim PropertyConsultantName As String
    Dim PropertyDeveloper As String
    Dim PropertyDeveloperName As String
    Dim PropertyModule As String
    Dim PropertyTechnicalID As String
    Dim PropertyChangeID As String
    Dim PropertySolmanID As String
    Dim PropertyTitle As String
    
    Dim MetaDataIDs(8) As String
    MetaDataIDs(0) = "Title"
    MetaDataIDs(1) = "Comments"
    MetaDataIDs(2) = "Subject"
    MetaDataIDs(3) = "Keywords"
    MetaDataIDs(4) = "Author"
    MetaDataIDs(5) = "Category"
    MetaDataIDs(6) = "Company"
    MetaDataIDs(7) = "Language"
    MetaDataIDs(8) = "Content Status"
  ' End of MetaData Integration
    
  ' Tables formatting preparation
    Application.DisplayStatusBar = True
    Application.StatusBar = "Tables formatting preparation..."

    table_max = 0
    table_max_cell = 0
    table_counter = 1
    For Each table In ActiveDocument.Tables
        
      ' Table - Used Objects in Transport
        If ActiveDocument.Tables(table_counter).Title = "TransportObjectTable" Then
            table_max = table_max + 1
            table_max_cell = table_max_cell + (ActiveDocument.Tables(table_counter).Rows.Count * 5)
        End If
        
      ' Table - New Codes
        If ActiveDocument.Tables(table_counter).Title = "CodeNewTable" Then
            table_max = table_max + 1
            table_max_cell = table_max_cell + (ActiveDocument.Tables(table_counter).Rows.Count * 2)
        End If
        
      ' Table - Code Changes
        If ActiveDocument.Tables(table_counter).Title = "CodeChangesTable" Then
            table_max = table_max + 1
            table_max_cell = table_max_cell + (ActiveDocument.Tables(table_counter).Rows.Count * 2)
        End If
        
      ' Table - Structure Changes
        If ActiveDocument.Tables(table_counter).Title = "StructureChangesTable" Then
            table_max = table_max + 1
            table_max_cell = table_max_cell + (ActiveDocument.Tables(table_counter).Rows.Count * 2)
        End If

        table_counter = table_counter + 1
    Next
    
  ' Tables formatting
    table_actual_cell = 0
    table_actual = 0
    table_counter = 1
    For Each table In ActiveDocument.Tables
            
      ' MetaData Integration
        If ActiveDocument.Tables(table_counter).Title = "MetadataIntegrationTable" Then
            counter = 0
            
            Dim PropertyID As String
            Dim PropertyValue As String
            
            For Each c In ActiveDocument.Tables(table_counter).Range.Cells
                counter = counter + 1
                If counter > 1 Then
                    If counter Mod 2 = 0 Then
                        PropertyID = c.Range.Text
                        PropertyID = Left(PropertyID, Len(PropertyID) - 2)
                    Else
                        PropertyValue = c.Range.Text
                        PropertyValue = Left(PropertyValue, Len(PropertyValue) - 2)
                        
                        If arrayPos(MetaDataIDs, PropertyID) <> -1 Then
                            ActiveDocument.BuiltInDocumentProperties(PropertyID).Value = PropertyValue
                        End If
                    End If
                End If
            Next
        End If
                
      ' Table - Used Objects in Transport
        If ActiveDocument.Tables(table_counter).Title = "TransportObjectTable" Then
            table_actual = table_actual + 1
            counter = 0
            
            For Each c In ActiveDocument.Tables(table_counter).Range.Cells
                table_actual_cell = table_actual_cell + 1
                counter = counter + 1
            
                If counter > 5 Then                                               ' Skip the header line
                    color = wdColorWhite                                          ' White
                    If counter Mod 5 = 0 Then
                        If Left(c.Range.Text, 11) = "#no_handled" Then
                            color = RGB(251, 228, 213)                            ' Light Red
                        End If
                    End If
                    
                    c.Shading.BackgroundPatternColor = color
                End If
                Call StatusBar(table_actual, table_max, table_actual_cell, table_max_cell)
            Next
        End If
    
      ' Table - New Codes
        If ActiveDocument.Tables(table_counter).Title = "CodeNewTable" And ActiveDocument.Tables(table_counter).Rows.Count > 2 Then
            table_actual = table_actual + 1
            counter = 0
            
            For Each c In ActiveDocument.Tables(table_counter).Range.Cells
                table_actual_cell = table_actual_cell + 1
                counter = counter + 1

                If counter Mod 2 <> 0 Then
                    If Left(Trim(Mid(c.Range.Text, 8, Len(c.Range.Text))), 1) <> "" Then
                      LeftCharASCII = Asc(Left(Trim(Mid(c.Range.Text, 8, Len(c.Range.Text))), 1))
                    End If
                    
                  ' ASCII-42 = * | ASCII-34 / ASCII-147 / ASCII-148 = "
                    If LeftCharASCII = 42 Or LeftCharASCII = 34 Or LeftCharASCII = 147 Or LeftCharASCII = 148 Then
                        color = RGB(240, 240, 240)                                ' Light Gray
                        bold = True
                    ElseIf Left(c.Range.Text, 1) = "." Then
                        color = wdColorWhite                                      ' White
                        bold = False
                    Else
                        color = RGB(255, 255, 153)                                ' Light Yellow
                        bold = False
                    End If
                End If
                
                c.Shading.BackgroundPatternColor = color
                c.Range.bold = bold
                Call StatusBar(table_actual, table_max, table_actual_cell, table_max_cell)
            Next
        End If
        
      ' Table - Code Changes
        If ActiveDocument.Tables(table_counter).Title = "CodeChangesTable" And ActiveDocument.Tables(table_counter).Rows.Count > 2 Then
            table_actual = table_actual + 1
            counter = 0
            
            For Each c In ActiveDocument.Tables(table_counter).Range.Cells
                table_actual_cell = table_actual_cell + 1
                counter = counter + 1
                                
                If counter <= 6 Then
                    c.Shading.BackgroundPatternColor = RGB(240, 240, 240)         ' Light Gray
                Else
                    If Left(c.Range.Text, 1) = "U" Or Left(c.Range.Text, 1) = "I" Or Left(c.Range.Text, 1) = "D" Then
                        If counter Mod 2 = 0 Then
                            c.Shading.BackgroundPatternColor = RGB(255, 229, 153) ' Light Gold
                        Else
                            c.Shading.BackgroundPatternColor = RGB(217, 226, 243) ' Light Blue
                            
                            If Left(Trim(Mid(c.Range.Text, 8, Len(c.Range.Text))), 1) <> "" Then
                              LeftCharASCII = Asc(Left(Trim(Mid(c.Range.Text, 8, Len(c.Range.Text))), 1))
                            End If
                            
                          ' ASCII-42 = * | ASCII-34 / ASCII-147 / ASCII-148 = "
                            If LeftCharASCII = 42 Or LeftCharASCII = 34 Or LeftCharASCII = 147 Or LeftCharASCII = 148 Then
                               c.Range.bold = True
                            End If
                        End If
                    Else
                        c.Shading.BackgroundPatternColor = wdColorWhite           ' White
                    End If
                End If
                Call StatusBar(table_actual, table_max, table_actual_cell, table_max_cell)
            Next
        End If
        
      ' Table - Structure Changes
        If ActiveDocument.Tables(table_counter).Title = "StructureChangesTable" And ActiveDocument.Tables(table_counter).Rows.Count > 2 Then
            table_actual = table_actual + 1
            counter = 0
            
            For Each c In ActiveDocument.Tables(table_counter).Range.Cells
                table_actual_cell = table_actual_cell + 1
                counter = counter + 1
                
                If counter <= 10 Then
                    c.Shading.BackgroundPatternColor = RGB(240, 240, 240)         ' Light Gray
                Else
                    If Left(c.Range.Text, 1) = "U" Or Left(c.Range.Text, 1) = "I" Or Left(c.Range.Text, 1) = "D" Then
                        If counter Mod 2 = 0 Then
                            c.Shading.BackgroundPatternColor = RGB(255, 229, 153) ' Light Gold
                        Else
                            c.Shading.BackgroundPatternColor = RGB(217, 226, 243) ' Light Blue
                        End If
                    Else
                        c.Shading.BackgroundPatternColor = wdColorWhite           ' White
                    End If
                End If
                Call StatusBar(table_actual, table_max, table_actual_cell, table_max_cell)
            Next
        End If
        
        table_counter = table_counter + 1
    Next
        
    Application.StatusBar = "Text formatting..."

 ' #no_handled
    With ActiveDocument.Range
        With .Find
            .ClearFormatting
            .MatchWholeWord = True
            .MatchCase = True
            .Execute FindText:="#no_handled"
        End With
        
        Do While .Find.Found
            .Select
            .Font.TextColor = wdColorRed                                          ' Red
            .Collapse wdCollapseEnd
            .Find.Execute
        Loop
    End With
    
  ' Text: #no_text
    With ActiveDocument.Range
        With .Find
            .ClearFormatting
            .MatchWholeWord = True
            .MatchCase = True
            .Execute FindText:="#no_text"
        End With
        
        Do While .Find.Found
            .Select
            .Font.TextColor = wdColorRed                                          ' Red
            .Collapse wdCollapseEnd
            .Find.Execute
        Loop
    End With
    
    Call textChange("&USE&", "USE")
    Call textChange("&MAINTENANCE&", "MAINTENANCE")
    Call textChange("&DEFINITION&", "DEFINITION")
    Call textChange("&EXAMPLES&", "EXAMPLES")
    Call textChange("&PURPOSE&", "PURPOSE")
    Call textChange("&INTEGRATION&", "INTEGRATION")
    Call textChange("&PREREQUISITES&", "PREREQUISITES")
    Call textChange("&FEATURES&", "FEATURES")
    Call textChange("&SELECTION&", "SELECTION")
    Call textChange("&STANDARD_VARIANTS&", "STANDARD_VARIANTS")
    Call textChange("&OUTPUT&", "OUTPUT")
    Call textChange("&ACTIVITIES&", "ACTIVITIES")
    Call textChange("&EXAMPLE&", "EXAMPLE")
    
    Application.StatusBar = "Document formatting has been completed!"
    
    Selection.GoTo what:=wdGoToPage, which:=wdGoToAbsolute, Count:=1

End Sub

Sub textChange(textFrom As String, textTo As String)
    With ActiveDocument.Range
        With .Find
            .ClearFormatting
            .MatchWholeWord = True
            .MatchCase = True
            .Execute FindText:=textFrom
        End With
        
        Do While .Find.Found
            .Select
            .Font.bold = True
            .Font.Italic = True
            .Text = textTo
            .Collapse wdCollapseEnd
            .Find.Execute
        Loop
    End With
End Sub

Function arrayPos(myArray, myValue)
    arrayPos = -1
    
    For i = LBound(myArray) To UBound(myArray)
        If LCase(myArray(i)) = LCase(myValue) Then
            arrayPos = i
            Exit For
        End If
    Next
End Function

Sub StatusBar(table_actual As Integer, table_max As Integer, table_actual_cell As Long, table_max_cell As Long)
    Dim percent As Integer
    
    percent = (table_actual_cell / table_max_cell) * 100
    If table_actual_cell Mod 50 = 0 Or table_actual_cell >= table_max_cell Then
        Application.StatusBar = "[" & "Number of processed tables: " & table_actual & " / " & table_max & "] [" & "Number of processed cells: " & table_actual_cell & " / " & table_max_cell & "] [" & "Processing status: " & percent & "%" & "]"
    End If
End Sub