Attribute VB_Name = "NewNotationConvertorWord2003"
'This macro has been verified on 2011/03/09 by Hélène Hauduc
'This macro aims at updating former ASM-type model notation in a Word2003 document
'This do not allow to modify notation inside equation objects
'The file "New-Notation.xls" is required for this macro

Sub NewNotationConvertorWord2003()
    Dim FindStringArray() As String 'Array with former notation
    Dim ReplaceStringArray() As String 'Array with new notation
    Dim ArrayEnd As Integer
    Dim Chemin As String
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlSh As Object
    Dim iR As Integer 'number of rows (characters to replace) in the Excel sheet
    Dim i As Integer
    Dim lgth0, lgth1, lgth2, b1, b2, b3 As Integer
    Dim subs As String
    Dim notat As String

    'Open Excel
    Chemin = ThisDocument.Path
    Set xlApp = GetObject(, "Excel.application")
    Set xlWb = xlApp.Workbooks.Open(Chemin & "\NewNotationConvertor-Word2003.xls")
    Set xlSh = xlWb.Worksheets(1)
    'number of raws (characters to replace)
    iR = 1
    Do While xlSh.Cells(1, iR + 1).Value <> ""
        iR = iR + 1
    Loop
    
        ReDim FindStringArray(iR - 1)
        ReDim ReplaceStringArray(iR - 1)
    
    'Loop to read table
    'First raw contain titles : start at i=2
    For i = 2 To iR
            FindStringArray(i - 1) = xlSh.Cells(i, 1).Value 'Array with former notation
            ReplaceStringArray(i - 1) = xlSh.Cells(i, 2).Value 'Array with new notation

    Next i
    
    'Quit Excel
    xlWb.Close
    xlApp.Quit
    Set xlSh = Nothing
    Set xlWb = Nothing
    Set xlApp = Nothing
    


    ' Find and replace
    ' for each Find
    For i = 1 To iR - 1
    
        'initialisation
        b1 = 0 'position of (
        b2 = 0  'position of )
        b3 = 0  'position of /
        lgth0 = 0 'main letter length
        lgth1 = 0 'subscript length
        lght2 = 0 'upperscript length
        notat = "" 'main letter
        subs = "" 'subscript
        supers = "" 'upperscript
        
        notat = ReplaceStringArray(i)
        b1 = InStr(notat, "(")
        b2 = InStr(notat, ")")
        b3 = InStr(notat, "/")
        Firstlevel = Left(notat, b1 - 1)
        lgth0 = Len(Firstlevel)
        
        If b3 = 0 Then
            subs = Mid(notat, b1 + 1, b2 - b1 - 1)
            lgth1 = Len(subs)
            Else
            subs = Mid(notat, b1 + 1, b3 - b1 - 1)
            supers = Mid(notat, b3 + 1, b2 - b3 - 1)
            lgth1 = Len(subs)
            lgth2 = Len(supers)
        End If
        
      
        With Selection.Find
            .Wrap = wdFindContinue
            .Forward = True
            .MatchWholeWord = True
            .MatchCase = True
            .Text = FindStringArray(i)
            .Replacement.Text = ""
        End With
        
        b = True
        Do While b = True
            With Selection
                'selection
                .Find.Execute
                
                'If selection is the variable to change
                If Selection = FindStringArray(i) Then
                    b = True
                    Else: b = False 'else exit loop, next i
                    Exit Do
                End If
                
                'write the firstlevel
                .TypeText Text:=Firstlevel
                .MoveLeft Unit:=wdCharacter, Count:=lgth0, Extend:=lgth0
                .Font.Italic = True
                
                'write the subscript
                .MoveRight Unit:=wdCharacter, Count:=1
                .TypeText Text:=subs
                'change font of subscript
                .MoveLeft Unit:=wdCharacter, Count:=lgth1, Extend:=lgth1
                .Font.Subscript = True
                .Font.Italic = False
                
                If b3 <> 0 Then
                'write the superscript
                .MoveRight Unit:=wdCharacter, Count:=1
                .TypeText Text:=supers
                'change font of superscript
                .MoveLeft Unit:=wdCharacter, Count:=lgth2, Extend:=lgth2
                .Font.Superscript = True
                End If
                
                'change position of cursor
                .MoveRight Unit:=wdCharacter, Count:=1
            End With
 
        Loop
    Next 'i

End Sub