ExcelGlossary - VB Script

Glossary.vbs

    Option Explicit
    
    Const kOpenTermChar = "{"
    Const kCloseTermChar = "}"
    Const kExternalTermChar = "^"
    Const kQuotingChar = """"
    
    Const kNewTermIdPrefix = "-"
    Const kTermIdDelimiter = "#"
    
    
    Const kTermDelimiters = " (),;:.?!(){}^$<>/\|@#""'^§°%µ£"
    
    
    '---------- Excel Zone that should be defined in the glossary sheet ----------------
    
    
    '--- Glossary
    Const kGlossarySheet = "Glossary"
    
    Const kGlossaryTableZone = "GlossaryTableZone"
    
    Const kGlossaryContextZone = "GlossaryContextZone"
    Const kGlossaryDefinitionZone = "GlossaryDefinitionZone"
    Const kGlossaryExampleZone = "GlossaryExampleZone"
    Const kGlossaryReferenceZone = "GlossaryReferenceZone"
    Const kGlossarySynonymsZone = "GlossarySynonymsZone"
    Const kGlossaryTermZone = "GlossaryTermZone"
    Const kGlossaryTranslationZone = "GlossaryTranslationZone"
    
    
    
    
    
    
    
    Const kReferencedByZone = "ReferencedByZone"
    
    
    
    
    Const kInternalReferenceTableZone = "_ReferenceTableZone"
    Const kInternalReferenceGlossaryDefinition = 1
    Const kInternalReferenceRefInLexicon = 2
    Const kInternalReferenceRefInGlossary = 3
    
    
    
    Const kInternalReferenceSummaryTableZone = "_ReferenceSummaryTableZone"
    Const kInternalReferenceSummaryTermId = 1
    Const kInternalReferenceSummaryRefTo = 2
    Const kInternalReferenceSummaryRefFrom = 3
    Const kInternalReferenceSummaryTerm = 4
    Const kInternalReferenceSummaryDefinition = 5
    Const kInternalReferenceSummaryRefToTerms = 6
    Const kInternalReferenceSummaryRefFromTerms = 7
    Const kInternalReferenceSummaryOut = 8
    Const kInternalReferenceSummaryIn = 9
    
    Const kExportSheetName = "_X"
    
    Const kBlack = 0
    Const kBlue = -4165632
    Const kDarkRed = -14614363
    
    
    Dim g As Integer
    
    
    
    
    Function pair(value1 As Variant, value2 As Variant, Optional key1 As String = "from", Optional key2 As String = "to") As Collection
        Dim result As New Collection
        Call result.Add(value1, key1)
        Call result.Add(value2, key2)
        Set pair = result
    End Function
    
    'Function FindInCollection(elem As Variant, coll As Collection, Optional start As Integer = 1, Optional key As Variant = Null) As Integer
    '    Dim i, n As Integer
    '    Dim found As Boolean
    '    found = False
    '    i = start
    '    n = coll.Count
    '    While (i <= n And Not found)
    '        If ...............................
    '        If coll(i) = elem Then
    '            found = True
    '        Else
    '            i = i + 1
    '        End If
    '    Wend
    '    If found Then
    '        FindInArray = i
    '    Else
    '        FindInArray = -1
    '    End If
    'End Function
    
    ' not used
    
    
    Function TrimString(aString As String) As String
        TrimString = ReplaceString(aString, " ", "")
    End Function
    
    ' replace ALL occurrences of a string by another one
    Function ReplaceString(aString As String, toFind As String, toReplace As String) As String
        Dim szReturn As String
        Dim nPosition As Integer
        Dim nPreviousPosition As Integer
        szReturn = ""
        nPreviousPosition = 1
        Do
            nPosition = InStr(nPreviousPosition, aString, toFind)
            If (nPosition <> 0) Then
                szReturn = szReturn & Mid(aString, nPreviousPosition, nPosition - nPreviousPosition) & toReplace
            Else
                szReturn = szReturn & Mid(aString, nPreviousPosition, Len(aString) - nPreviousPosition + 1)
            End If
            nPreviousPosition = nPosition + Len(toFind)
        Loop While (nPosition <> 0)
        ReplaceString = szReturn
    End Function
    
    Function ParseSimpleBracketedExpr(text As String, _
                            Optional openSeparator As String = "(", _
                            Optional closeSeparator As String = ")", _
                            Optional doTrim As Boolean = True) _
                            As Collection
        Dim result As New Collection
        Dim beforeBracket, inBracket, afterBracket As String
        If (text = "") Then
            beforeBracket = ""
            inBracket = ""
            afterBracket = ""
        Else
            Dim leftParenthesisPos, rightParenthesisPos As Integer
            leftParenthesisPos = InStr(1, text, openSeparator)
            rightParenthesisPos = InStr(leftParenthesisPos + 1, text, closeSeparator)
            If (leftParenthesisPos >= 1 And rightParenthesisPos >= 1 And rightParenthesisPos >= leftParenthesisPos) Then
                beforeBracket = Mid(text, 1, leftParenthesisPos - 1)
                inBracket = Mid(text, leftParenthesisPos + 1, rightParenthesisPos - leftParenthesisPos - 1)
                afterBracket = Mid(text, rightParenthesisPos + 1, Len(text) - rightParenthesisPos)
            Else
                beforeBracket = text
                inBracket = ""
                afterBracket = ""
            End If
            If (doTrim) Then
                beforeBracket = Trim(beforeBracket)
                inBracket = Trim(inBracket)
                afterBracket = Trim(afterBracket)
            End If
        End If
        Call result.Add(beforeBracket, "before")
        Call result.Add(inBracket, "in")
        Call result.Add(afterBracket, "after")
        Set ParseSimpleBracketedExpr = result
    End Function
    
    
    Function FindInArray(elem As Variant, elems As Variant, Optional start As Integer = 0) As Integer
        Dim i, n As Integer
        Dim found As Boolean
        found = False
        i = start
        n = UBound(elems)
        While (i <= n And Not found)
            If elems(i) = elem Then
                found = True
            Else
                i = i + 1
            End If
        Wend
        If found Then
            FindInArray = i
        Else
            FindInArray = -1
        End If
    End Function
    ' Return the NextFreeString position as an interval where
    '    Start is the position of the first character of the free string
    '    End is the position of the character AFTER the string.
    '    If the free string is empty Start=End
    '
    'Function NextFreeString(sText As String, Optional nBegin As Integer = 1, Optional sDelimiter As String = "'") As IntegerInterval
    '    Dim nStart, nEnd, nFirstDelimiter As Integer
    '    If (Len(sText) = 0) Then
    '        ' The string is empty
    '        nStart = nBegin
    '        nEnd = nBegin
    '    Else
    '        nFirstDelimiter = InStr(nBegin, sText, sDelimiter)
    '        If (nFirstDelimiter >= 1) Then
    '            ' The next free string start from the begining to the delimiter
    '            nStart = nBegin
    '            nEnd = nFirstDelimiter
    '        Else
    '            ' The next free string goes to the end
    '            nStart = nBegin
    '            nEnd = Len(sText)
    '        End
    '    End
    '    NextFreeString.Start = nStart
    '    NextFreeString.End = nEnd
    'End Function
    
    
    ' this function indicates if col.item(key). Otherwise it generates an error!
    Function ContainsKey(col As Collection, key As Variant) As Boolean
        Dim itm As Variant
        On Error Resume Next
        itm = col.Item(key)
        ContainsKey = Not (Err.Number = 5 Or Err.Number = 9)
        On Error GoTo 0
    End Function
    
    Function PositionInCollection(col As Collection, value As Variant) As Integer
        Dim v As Variant
        Dim i As Integer
        Dim position As Integer
        position = -1
        i = 0
        For Each v In col
            i = i + 1
            If (v = value) Then
                position = i
                Exit For
            End If
        Next v
        PositionInCollection = position
    End Function
    
    
    
    Function JoinCollection(coll As Collection, Optional delimiter As String = "") As String
        Dim result As String
        Dim i As Integer
        Dim elem
        If coll.Count = 0 Then
            result = ""
        Else
            i = 1
            For Each elem In coll
                If (i <> 1) Then
                    result = result & delimiter
                End If
                result = result & CStr(elem)
                i = i + 1
            Next elem
        End If
        JoinCollection = result
    End Function
    
    ' Split the text according to the given delimiters
    ' return either a collection of strings or a collection of "fullSegment"
    ' a Full segment is a collection with a key "text", "position", "previousDelimiter"
    Function SplitMultipleDelimiters(sText As String, sDelimiters As String, _
                                    Optional sQuotingDelimiters As String = """", _
                                    Optional returnFullSegments As Boolean = False) As Collection
        Dim segments As New Collection
        Dim i As Integer
        Dim c As String
        Dim nBeginSegment As Integer
        Dim currentString As String
        Dim lastDelimiter As String
        Dim cIsDelimiter As Boolean
        Dim cIsQuotingDelimiter As Boolean
        Dim fullSegment As Collection
        Dim inQuotedString As Boolean
        Dim idx As Integer
        currentString = ""
        lastDelimiter = ""
        nBeginSegment = 1
        inQuotedString = False
        
        For idx = 1 To Len(sText)
            c = Mid(sText, idx, 1)
            cIsQuotingDelimiter = (InStr(1, sQuotingDelimiters, c) >= 1)
            If cIsQuotingDelimiter Then
                inQuotedString = Not inQuotedString
            End If
            
            ' delimiters chars are ignored if there are in quoted string
            cIsDelimiter = (Not inQuotedString) And (InStr(1, sDelimiters, c) >= 1)
                    
            If (Not cIsDelimiter) Then
                ' This is not a delimiter
                currentString = currentString & c
             
            End If
            If (cIsDelimiter Or idx = Len(sText)) Then
            
                If (returnFullSegments) Then
                    Set fullSegment = New Collection
                    fullSegment.Add key:="text", Item:=currentString
                    fullSegment.Add key:="position", Item:=nBeginSegment
                    fullSegment.Add key:="previousDelimiter", Item:=lastDelimiter
                    segments.Add fullSegment
                Else
                    segments.Add currentString
                End If
                        
                'we start another string
                currentString = ""
                nBeginSegment = idx + 1
            End If
            If (cIsDelimiter) Then
                lastDelimiter = c
            End If
        Next idx
        Set SplitMultipleDelimiters = segments
    End Function
    
    
    Function AlternateCollection(coll As Collection, nBegin As Integer, nPeriod As Integer) As Collection
        Dim result As New Collection
        Dim idx As Integer
        For idx = 1 To coll.Count
            If (idx - nBegin) Mod nPeriod = 0 Then
                result.Add (coll(idx))
            End If
        Next idx
        Set AlternateCollection = result
    End Function
    
    Function MapItemCollection(coll As Collection, key As Variant) As Variant
        Dim result As New Collection
        For Each elem In coll
            result.Add (elem.Item(key))
        Next elem
        Set MapItemCollection = result
    End Function
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    '====================================  XLS General helpers ===============================================
    
    
    Function XLSSetCellCharacters(cell As Range, start As Integer, lgth As Integer, Color As Long, Optional style As String = "")
        With cell.Characters(start, lgth).Font
            .Color = Color
            .FontStyle = style
        End With
    End Function
    
    Function XLSLastNRow(R As Range) As Integer
        XLSLastNRow = R.Row + XLSRangeHeight(R) - 1
    End Function
    
    Function XLSRangeHeight(R As Range) As Integer
        XLSRangeHeight = R.Rows.Count
    End Function
    
    Function XLSRangeWidth(R As Range) As Integer
        XLSRangeWidth = R.Columns.Count
    End Function
    
    Function XLSRangeBottomRight(R As Range) As Range
        Set XLSRangeBottomRight = R.Item(XLSRangeHeight(R), XLSRangeWidth(R))
    End Function
    
    Function XLSTopRight(R As Range) As Range
        Set XLSTopRight = R.cells(1, 1)
    End Function
    
    Sub XLSDimZone(name As String, height As Integer, Optional width As Integer = -1)
        Dim originalRange As Range
        Dim worksheetName As String
        Dim h As Integer
        Dim w As Integer
        Dim ref As String ' the reference of the new calculated zone
        Set originalRange = Names(name).RefersToRange
        If height = 0 Then
            h = 1
        Else
            h = height
        End If
        If width = -1 Then
            w = originalRange.Columns.Count
        Else
            w = width
        End If
        worksheetName = originalRange.Worksheet.name
        ref = worksheetName & "!" _
                & "R" & CStr(originalRange.Row) & "C" & CStr(originalRange.Column) _
                & ":" _
                & "R" & CStr(originalRange.Row + h - 1) & "C" & CStr(originalRange.Column + w - 1)
        Names(name).RefersToR1C1 = "=" & ref
    End Sub
    
    
    
    
    
    
    
    
    
    '=========================== Glossary helpers ==========================================
    
    Sub RedimGlossaryTableAndZones()
        Dim tableHeaderRow, firstTableRow, lastTableRow, zonesHeight, iz As Integer
        tableHeaderRow = Range(kGlossaryTableZone).Row
        firstTableRow = tableHeaderRow + 1
        lastTableRow = Sheets(kGlossarySheet).UsedRange.Rows.Count
        zonesHeight = lastTableRow - firstTableRow + 1
        Call XLSDimZone(kGlossaryTableZone, (zonesHeight + 1))
        Dim zone As Variant
        Dim zonename As String
        For Each zone In Array( _
                    kGlossaryContextZone, kGlossaryDefinitionZone, kGlossaryExampleZone, kGlossaryReferenceZone, _
                    kGlossarySynonymsZone, kGlossaryTermZone, kGlossaryTranslationZone)
            zonename = zone
            Call XLSDimZone(zonename, (zonesHeight))
        Next zone
    End Sub
    
    
    Function IsTermDelimiter(char As String) As Boolean
        If (char = "") Then
            IsTermDelimiter = True
        Else
            IsTermDelimiter = (InStr(1, kTermDelimiters, char) >= 1)
        End If
    End Function
    
            
    Function GetSingularAndPlural(termExpr As String)
        Dim result As New Collection
        Dim singular, plural, suffix As String
        Dim parseResult As Collection
        Set parseResult = ParseSimpleBracketedExpr(termExpr, "(", ")", True)
        singular = parseResult.Item("before")
        suffix = parseResult.Item("in")
        If (suffix = "") Then
            plural = ""
        Else
            If (suffix = "s" Or suffix = "es") Then
                plural = singular & suffix
            Else
                If (suffix = "ies" And Right(singular, 1) = "y") Then
                    plural = Left(singular, Len(singular) - 1) & "ies"
                Else
                    If (Len(suffix) > 3) Then
                        plural = suffix
                    Else
                        plural = singular & suffix
                    End If
                End If
            End If
        End If
        Call result.Add(singular, "singular")
        Call result.Add(plural, "plural")
        Set GetSingularAndPlural = result
    End Function
    
    Function GetSingularTerm(iGlossaryTerm As Integer) As String
        GetSingularTerm = GetSingularAndPlural(Range(kGlossaryTermZone).Item(iGlossaryTerm).value).Item("singular")
    End Function
    
    Function GetDefinition(iGlossaryTerm As Integer) As String
        GetDefinition = Range(kGlossaryDefinitionZone).Item(iGlossaryTerm).value
    End Function
    
    Function GetSynonymsExpr(iGlossaryTerm As Integer) As String
        GetSynonymsExpr = Range(kGlossarySynonymsZone).Item(iGlossaryTerm).value
    End Function
    
    
    Function GetSynonyms(iGlossaryTerm As Integer) As Collection
        Dim expr As String
        Dim synonymExpr As Variant 'object/string
        Dim synonymParts As New Collection
        Dim synonym As String
        Dim synonyms As New Collection
        expr = GetSynonymsExpr(iGlossaryTerm)
        For Each synonymExpr In SplitMultipleDelimiters(expr, ";", "", False)
            Set synonymParts = ParseSimpleBracketedExpr((synonymExpr), "(", ")", True)
            synonym = synonymParts.Item("before")
            If (synonym <> "") Then
                synonyms.Add (synonym)
            End If
        Next synonymExpr
        Set GetSynonyms = synonyms
    End Function
    
    
    
    Function AllSubTerms(term As String) As Collection 'of Strings
        Dim rawColl As New Collection
        Dim uniTermColl As New Collection
        Dim resultColl As New Collection
        Dim R, uniTerm, subTerm As String
        Set rawColl = SplitMultipleDelimiters(term, kTermDelimiters, kQuotingChar, False)
        ' some of the terms in the collection may be "". Filter them.
        For Each R In rawColl
            If (R <> "") Then
                uniTermColl.Add (R)
            End If
        Next R
        ' generate all intervals and add them to the list of subterm
        ' for instance if the maximum is 3
        ' the intervals are 1 ; 1,2 then 2 ; 2,3 then 3
        Dim max, lowBound, highBound, i As Integer
        max = uniTermColl.Count
        For lowBound = 1 To max
            For highBound = lowBound To max
                If (highBound - lowBound + 1 < max) Then
                    'subTerm = term & "[" & CStr(lowBound) & "," & CStr(highBound) & "]"
                    subTerm = ""
                    For i = lowBound To highBound
                        If i <> lowBound Then
                            subTerm = subTerm & " "
                        End If
                        subTerm = subTerm & uniTermColl.Item(i)
                    Next i
                    resultColl.Add (subTerm)
                End If
            Next highBound
        Next lowBound
        Set AllSubTerms = resultColl
    End Function
    
    
    
    ' replace all occurrence of a term in a string. Do not take into account delimiters or quotes.
    ' if a plural with an s is detected then the replacement is done anyway. Check the details in
    ' the procedure
    Function ReplaceTermInFreeString(term As String, replacement As String, text As String) As String
        Dim lowerTerm As String
        lowerTerm = LCase(term)
        
        Dim lenTerm As Integer
        lenTerm = Len(term)
        
        Dim lenText As Integer
        lenText = Len(text)
        
        Dim lowerText As String
        lowerText = LCase(text)
    
        Dim termFound As Boolean
        Dim termPosition As Integer
        Dim positionOfRemainingText As Integer
        Dim newText As String
        newText = ""
        
        positionOfRemainingText = 1
        Do
            ' searched the lowercased version of the term in the lowerversion of the text
            termPosition = InStr(positionOfRemainingText, lowerText, lowerTerm, vbTextCompare)
            If (termPosition >= 1) Then
                                
                'the term is textually found, but we should check if this occurence is clearly delimitated
                'otherwize a term will be detected within words (e.g. engineer in engineering)
                Dim beforeOk, afterOk As Boolean
                ' check what is the character before the text. Should be a delimiter or the begining of the string
                If (termPosition = 1) Then
                     beforeOk = True
                Else
                     beforeOk = IsTermDelimiter(Mid(lowerText, termPosition - 1, 1))
                End If
                                    
                ' check what is the character after the text.
                ' since we want to deal with plural, this is a little bit more complicated
                ' For instance group should be found in groups but not groupss
                                    
                ' first case: this is the end of the text: cool, that's is
                If (termPosition + lenTerm > lenText) Then
                    afterOk = True
                                        
                ' there is a character after the term found
                Else
                    ' check which char it is
                    Dim nextChar As String
                    nextChar = Mid(lowerText, termPosition + lenTerm, 1)
                    If (IsTermDelimiter(nextChar)) Then
                        afterOk = True
                    Else
                        If (nextChar = "s") Then
                            ' this seems to be a plural. But check if this is the case
                            If (termPosition + lenTerm + 1 > lenText) Then
                                 ' the s is the last char. So this is the occurence of the term in its plura
                                 afterOk = True
                            Else
                                 ' check if the s is followed by a delimiter
                                 afterOk = IsTermDelimiter(Mid(lowerText, termPosition + lenTerm + 1, 1))
                            End If
                        Else
                            'this is not a s, nor a term delimiter
                            afterOk = False
                        End If 'nextChar = "s"
                    End If 'IsTermDelimiter(nextChar)
                End If 'termPosition >= 1
                termFound = beforeOk And afterOk
                If (termFound) Then
                    ' we found a valid occurrence of the term
                    ' output everything that was before this term + the term, and then continue after
                    newText = newText & Mid(text, positionOfRemainingText, termPosition - positionOfRemainingText) & replacement
                    positionOfRemainingText = termPosition + lenTerm
                Else
                    ' this is a false alert
                    ' we copy everything before + the term as found, and then we continue after
                    newText = newText & Mid(text, positionOfRemainingText, termPosition + lenTerm - positionOfRemainingText)
                    positionOfRemainingText = termPosition + lenTerm
                End If 'termFound
            Else
                newText = newText & Mid(text, positionOfRemainingText, lenText - positionOfRemainingText + 1)
                positionOfRemainingText = lenText + 1
            End If
        Loop While (positionOfRemainingText <= lenText)
        ReplaceTermInFreeString = newText
    End Function
    
    Function TermIdString(i As Integer, Optional prefix As String = "") As String
        TermIdString = kTermIdDelimiter & prefix & CStr(i) & kTermIdDelimiter
    End Function
    
    ' return either reference as '#34#' or 34,
    Function ExtractTermIds(text As String, returnString As Boolean) As Collection
        Dim results As New Collection
        Dim segment As Variant 'String
        For Each segment In AlternateCollection(SplitMultipleDelimiters(text, kTermIdDelimiter, kQuotingChar, False), 2, 2)
            If returnString Then
                results.Add (kTermIdDelimiter & segment & kTermIdDelimiter)
            Else
                results.Add (CInt(segment))
            End If
        Next segment
        Set ExtractTermIds = results
    End Function
    
    
    Function ReplaceAllPairsInFreeString(termPairs As Collection, text As String, Optional reverse As Boolean = False) As String
        Dim index As Integer
        Dim term As String
        Dim result As String
        Dim termPair As New Collection
        Dim source, target As String
        If Not reverse Then
            source = "from"
            target = "to"
        Else
            source = "to"
            target = "from"
        End If
        result = text
        For Each termPair In termPairs
            If (termPair.Item(source) <> "" And termPair.Item(target) <> "") Then
                result = ReplaceTermInFreeString((termPair.Item(source)), (termPair.Item(target)), result)
            End If
        Next termPair
        ReplaceAllPairsInFreeString = result
    End Function
    
    
    Function BuildCellAndStrIndexPairs(cells As Range, Optional reverse As Boolean = False) As Collection
        Dim pairs As New Collection
        Dim cell As Range
        Dim index As Integer
        Dim key1, key2 As String
        If reverse Then
            key1 = "to"
            key2 = "from"
        Else
            key1 = "from"
            key2 = "to"
        End If
        index = 0
        For Each cell In cells
            index = index + 1
            ' TODO we could use the Pair function
            Dim pair As Collection
            Set pair = New Collection
            Call pair.Add(cell.value, key1)
            Call pair.Add(TermIdString(index), key2)
            Call pairs.Add(pair)
        Next cell
        Set BuildCellAndStrIndexPairs = pairs
    End Function
    
    
    
    
    
    
    Function ReplaceTermIdsInString(lexiconReplacementToId As Collection, additionalTerms As Collection, text As String) As String
        Dim result As String
        Dim additionalTerm As Variant 'String
        Dim index As Integer
        ' we don't care about quotes, etc. The id have a very particular form, so...
        
        ' first replace the defined term id by their replacement string
        result = ReplaceAllPairsInFreeString(lexiconReplacementToId, text, True)
        
        ' replace the additional term id to their term
        index = 0
        For Each additionalTerm In additionalTerms
            index = index + 1
            result = ReplaceTermInFreeString(TermIdString(index, kNewTermIdPrefix), kOpenTermChar & additionalTerm & kCloseTermChar, result)
        Next additionalTerm
        ReplaceTermIdsInString = result
    End Function
    
    ' lexiconTermToId is a list of pairs of the form ("from"=>term, "to"=>theIdString)
    ' lexiconReplacementToId is a list of pairs of the form ("from"=>replacement string, "to"=>theIdString)
    ' additionalTerms is a In Out variable that accumulate terms that are to be defined
    '     this is a just a list of string. The corresponding id are calculated from the order of the string.
    Function ReplaceAllTermsByTheirIdInAString(lexiconTermToId As Collection, _
                                                lexiconReplacementToId As Collection, _
                                                text As String, _
                                                additionalTerms As Collection) As String
        Dim globalResult As String
        Dim segmentText As Variant 'text
        Dim newSegmentText As String
        Dim isQuotedString As Boolean
        ' quoted string alternate. There are even segments.
        isQuotedString = False
        globalResult = ""
        For Each segmentText In SplitMultipleDelimiters(text, kQuotingChar, "", False)
    
            If isQuotedString Then
                ' this is a quoted string. Just add it with the quotes without any kind of replacement
                newSegmentText = kQuotingChar & segmentText & kQuotingChar
                
            Else
                ' this is not a free string so we should replace the all the terms we can replace
                
                ' start with replacing the "lexicon replacements". As they are already quoted, this is easy
                newSegmentText = segmentText
                newSegmentText = ReplaceAllPairsInFreeString(lexiconReplacementToId, newSegmentText)
                
                ' Now all the term brackets that are still there are terms that the user want to define
                ' so we should check all occurrences of them and build a dictionnary
                Dim parseResult As Collection
                Dim before As String
                Dim into As String
                Dim after As String
                Dim subSegment As String
                Dim newId As Variant
                Dim additionalTermPosition As Integer
                subSegment = ""
                after = newSegmentText
                Do
                    Set parseResult = ParseSimpleBracketedExpr(after, kOpenTermChar, kCloseTermChar, False)
                    before = parseResult.Item("before")
                    into = parseResult.Item("in")
                    If into = "" Then
                        subSegment = subSegment & before
                    Else
                        additionalTermPosition = PositionInCollection(additionalTerms, into)
                        If (additionalTermPosition < 1) Then
                            ' the term is not in the additional dictionary. So add it
                            Call additionalTerms.Add(into)
                            newId = TermIdString(additionalTerms.Count, kNewTermIdPrefix)
                        Else
                            newId = TermIdString(additionalTermPosition, kNewTermIdPrefix)
                        End If
                        subSegment = subSegment & before & newId
                    End If
                    after = parseResult.Item("after")
                Loop While (after <> "")
                newSegmentText = subSegment
                
                ' now replace the "lexicon terms"
                newSegmentText = ReplaceAllPairsInFreeString(lexiconTermToId, newSegmentText)
            End If
            isQuotedString = Not isQuotedString
            globalResult = globalResult & newSegmentText
        Next segmentText
        ReplaceAllTermsByTheirIdInAString = globalResult
    End Function
    
    ' return a list of additional terms to add + a collection of reference pairs
    Function XLSReplaceAllTermsInARange(cells As Range, Optional cellOffset As Integer = 0) As Collection
        Dim cell As Range
        Dim nCell As Integer
        Dim dicoReplacement As Collection
        Dim dicoTerm As Collection
        Dim textWithIds As String
        Dim additionalTerms As New Collection
        Dim comment As String
        Dim referencePairs As New Collection 'of Pair
        Dim sourceReference As Integer
        Dim targetReference As Variant 'Integer
        Set dicoReplacement = BuildCellAndStrIndexPairs(Range("LexiconReplacementZone"))
        Set dicoTerm = BuildCellAndStrIndexPairs(Range("LexiconTermZone"))
        
        sourceReference = cellOffset
        For Each cell In cells
            sourceReference = sourceReference + 1
            textWithIds = ReplaceAllTermsByTheirIdInAString(dicoTerm, dicoReplacement, cell.value, additionalTerms)
            For Each targetReference In ExtractTermIds(textWithIds, False)
                ' note that we can't remove reflexive reference here because targetReference is in term of the lexicon, because they might be synonym, etc.
                Call referencePairs.Add(pair(sourceReference, CInt(targetReference)))
            Next targetReference
            comment = "=>" & JoinCollection(ExtractTermIds(textWithIds, True), ",") ' & "  --  " & textWithIds
            cell.ClearComments
            Call cell.AddComment(comment)
            cell.value = ReplaceTermIdsInString(dicoReplacement, additionalTerms, textWithIds)
        Next cell
        
        Dim result As Collection
        Set result = pair(additionalTerms, referencePairs, "additionalTerms", "referencePairs")
        Set XLSReplaceAllTermsInARange = result
    End Function
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Sub AddHyperlink()
    '
    ' Macro1 Macro
    ' c'est un test
    '
    '
      'ActiveCell.FormulaR1C1 = "12"
      
      With ActiveSheet
        Set GlossaryDefinitionZone = .Range(kGlossaryDefinitionZone)
        Set termZone = .Range(kGlossaryTermZone)
        Set seeAlsoZone = .Range(kSeeAlsoZone)
        Set referencedByZone = .Range(kReferencedByZone)
        Set debugZone = .Range(kDebugZone)
      End With
      
      'Compute the size of the zone. Should be all the same...
      Dim nZoneSize As Integer
      nZoneSize = termZone.Count
      If (GlossaryDefinitionZone.Count <> Count) Then
        'WriteErrorLog "TermZone has " + nZoneSize + " rows but GlossaryDefinitionZone has " + GlossaryDefinitionZone.Count
      End If
      
      'Get the first element
      Dim firstTermRow As Integer
      firstTermRow = termZone.cells(1, 1).Row
      
      Dim currentTerm As String
      Dim nRow As Integer
      Dim termToSearch As String
      Dim addressOfTargetCell As String
      Dim targetTermIndex As Integer
        
      For termIndex = 1 To nZoneSize
        referencedByZone.cells(termIndex, 1) = ""
      Next termIndex
      
      For termIndex = 1 To nZoneSize
        Set termCell = termZone.cells(termIndex, 1)
        currentTerm = termCell.value
        Set seeAlsoCell = seeAlsoZone.cells(termIndex, 1)
        If (seeAlsoCell.value <> "") Then
          termToSearch = seeAlsoCell.value
          Set targetCell = termZone.Find(What:=termToSearch)
          If (targetCell Is Nothing) Then
             debugZone.cells(termIndex, 1).value = "not found"
          Else
             addressOfTargetCell = CStr(targetCell.Address(RowAbsolute:=True, ColumnAbsolute:=False, RelativeTo:=termZone))
             targetTermIndex = targetCell.Row - firstTermRow + 1
             debugZone.cells(termIndex, 1).value = targetTermIndex
             Call ActiveSheet.Hyperlinks.Add(Anchor:=seeAlsoCell, _
                                         Address:="", _
                                         SubAddress:=addressOfTargetCell, _
                                         ScreenTip:="test", _
                                         TextToDisplay:=termToSearch)
                                         
             Set targetRefByCell = referencedByZone.cells(targetTermIndex, 1)
             If (targetRefByCell.value <> "") Then
               targetRefByCell.value = targetRefByCell.value + " ; " + currentTerm
             End If
             targetRefByCell.value = targetRefByCell.value + currentTerm
             'referencedByZone.Cells(termIndex, 1).Value + "; " + currentTerm
          End If
          
                                         'SubAddress:=addressOfTargetCell, _
                                         'ScreenTip:=valueToSearch,
        End If
    
        'For Each c In Range("MyRange")
        '    If c.Value > Limit Then
        '        c.Interior.ColorIndex = 27
        '    End If
        'Next c
    
                'If (Worksheet.Cells(nTempRow, nColumnRelatedElements).Value <> "") Then
                '    Worksheet.Columns("B:B").Find(What:=Worksheet.Cells(nTempRow, nColumnRelatedElements).Value, _
                '        After:=Worksheet.Cells(3, 2), LookIn:=xlFormulas, _
                '        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                '        MatchCase:=True, SearchFormat:=False).Activate
                '
                '    szHyperlink = CStr(ExcelApp.ActiveCell.Address(1, 0))
                '    If (szHyperlink <> "") Then
                '        Worksheet.Hyperlinks.Add Anchor:=Worksheet.Cells(nTempRow, nColumnRelatedElements), Address:="", SubAddress:=szHyperlink, _
                '            TextToDisplay:=Worksheet.Cells(nTempRow, nColumnRelatedElements).Value
                '    Else
                '        WriteErrorLog "unable to make hyperlink for " + Worksheet.Cells(nTempRow, nColumnRelatedElements).Value
                '    End If
                'End If
      Next termIndex
    End Sub
    
    
    
    
    
    
    
    
    '----------------------------------------------- Internal Tables Reference Management -----------------------------------
    
    Sub ClearInternalReferenceTable()
        Range(kInternalReferenceTableZone).offset(1).Clear
        Range(kInternalReferenceTableZone).offset(1).ClearComments
    End Sub
    
    
    Sub BuildInternalReferenceTable(referencePairs As Collection)
        Dim pair As Collection 'of pair("from","to")
        Dim table As Range
        Dim index As Integer
        Dim source, targetInLexicon, targetInGlossary As Integer
        Set table = Range(kInternalReferenceTableZone)
        index = 1
        For Each pair In referencePairs
            source = pair.Item("from")
            targetInLexicon = pair.Item("to")
            If targetInLexicon >= 1 Then
                targetInGlossary = Range("LexiconGlossaryIdZone").cells(targetInLexicon, 1).value
            Else
                targetInGlossary = targetInLexicon
            End If
            If (source <> targetInGlossary) Then
                table.cells(index + 1, kInternalReferenceGlossaryDefinition).value = source
                table.cells(index + 1, kInternalReferenceRefInLexicon).value = targetInLexicon
                table.cells(index + 1, kInternalReferenceRefInGlossary).value = targetInGlossary
                index = index + 1
            End If
        Next pair
        Call XLSDimZone(kInternalReferenceTableZone, index)
        
        
        Call BuildInternalReferenceSummaryTable
        Call XLSUpdateExportSheet
    End Sub
    
    Sub ClearInternalReferenceSummaryTable()
        Range(kInternalReferenceSummaryTableZone).offset(1, 0).Clear
        Range(kInternalReferenceSummaryTableZone).offset(1, 0).ClearComments
    End Sub
    
    
    
    Sub BuildInternalReferenceSummaryTable()
        Dim index As Integer
        Dim indexGlossary As Integer
        Dim sourceInGlossary, targetInGlossary As Integer
        Dim sourceIdStr, targetIdStr As String
        Dim pairTable As Range
        Dim summaryTable As Range
        Dim refTo, refFrom As String
        Set pairTable = Range(kInternalReferenceTableZone)
        Call ClearInternalReferenceSummaryTable
        Call XLSDimZone(kInternalReferenceSummaryTableZone, Range(kGlossaryTermZone).Rows.Count + 1)
        Set summaryTable = Range(kInternalReferenceSummaryTableZone)
    
        For index = 1 To pairTable.Rows.Count - 1  'the header does not count
            sourceInGlossary = pairTable.cells(index + 1, kInternalReferenceGlossaryDefinition).value
            sourceIdStr = TermIdString((sourceInGlossary)) 'XXX
            targetInGlossary = pairTable.cells(index + 1, kInternalReferenceRefInGlossary).value
            targetIdStr = TermIdString((targetInGlossary))
            
            ' add to the refTo if not already present
            refTo = summaryTable.cells(sourceInGlossary + 1, kInternalReferenceSummaryRefTo).value
            If (InStr(1, refTo, targetIdStr) >= 1) Then
                ' the reference to this glossary term is already there
            Else
                summaryTable.cells(sourceInGlossary + 1, kInternalReferenceSummaryRefTo).value = refTo & targetIdStr & ";"
            End If
            summaryTable.cells(sourceInGlossary + 1, kInternalReferenceSummaryOut).value = summaryTable.cells(sourceInGlossary + 1, kInternalReferenceSummaryOut).value + 1
            
            ' add to the refFrom list if not already present
            If targetInGlossary >= 1 Then
                refFrom = summaryTable.cells(targetInGlossary + 1, kInternalReferenceSummaryRefFrom).value
                If (InStr(1, refFrom, sourceIdStr) >= 1) Then
                    ' the reference is already there
                Else
                    summaryTable.cells(targetInGlossary + 1, kInternalReferenceSummaryRefFrom).value = refFrom & sourceIdStr & ";"
                End If
            End If
            ' FIXME
            If targetInGlossary >= 1 Then
                summaryTable.cells(targetInGlossary + 1, kInternalReferenceSummaryIn).value = summaryTable.cells(targetInGlossary + 1, kInternalReferenceSummaryIn).value + 1
            End If
        Next index
        Dim cleaned As String
        Dim reference As Variant 'string that is a int
        Dim refTerms As String
        Dim n As Integer
        Dim i As Integer
        For indexGlossary = 1 To Range(kGlossaryTermZone).Rows.Count
            summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryTermId) = indexGlossary
            summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryTerm) = GetSingularTerm(indexGlossary)
            summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryDefinition) = GetDefinition(indexGlossary)
            ' the code below is quite ugly. All that just to replace some StrIds to their equivalent! TODO clean it
            refTerms = ""
            i = 0
            For Each reference In Split(Replace(summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryRefTo).value, "#", ""), ";")
                i = i + 1
                If reference <> "" Then
                    n = CInt(reference)
                    If n >= 1 Then
                        If (i <> 1) Then
                            refTerms = refTerms & ";"
                        End If
                        refTerms = refTerms & GetSingularTerm(n)
                    End If
                End If
            Next reference
            summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryRefToTerms) = refTerms
            refTerms = ""
            i = 0
            For Each reference In Split(Replace(summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryRefFrom).value, "#", ""), ";")
                i = i + 1
                If reference <> "" Then
                    n = CInt(reference)
                    If n >= 1 Then
                        If (i <> 1) Then
                            refTerms = refTerms & ";"
                        End If
                        refTerms = refTerms & GetSingularTerm(n)
                    End If
                End If
            Next reference
            summaryTable.cells(indexGlossary + 1, kInternalReferenceSummaryRefFromTerms) = refTerms
    
        Next indexGlossary
        ' Call range(kInternalReferenceSummaryTableZone).Replace(What:="#",replacement:="",lookAT:=searchOrder,
    End Sub
    
    
    Sub XLSNewGlossaryTerm()
        Dim lastRow As Range
        Set lastRow = Rows(XLSLastNRow(Range(kGlossaryTermZone)))
        lastRow.Copy
        Call lastRow.Insert
        Call lastRow.ClearContents
        Call lastRow.ClearComments
        XLSRangeBottomRight(Range(kGlossaryTermZone)).Activate
    End Sub
    
    Sub XLSAddGlossaryTerm(term As String)
        Call XLSNewGlossaryTerm
        ActiveCell.value = term
    End Sub
    
    Sub XLSAddGlossaryTerms(terms As Collection)
        Dim term As Variant
        For Each term In terms
            Call XLSAddGlossaryTerm((term))
        Next term
    End Sub
    
    Sub XLSSortGlossaryTable()
        Call Range(kGlossaryTableZone).offset(1).Sort(Range(kGlossaryTermZone), xlAscending)
    End Sub
    
    
    Sub XLSReplaceAllTermsInRange(cells As Range, Optional offset As Integer = 0, Optional doColor As Boolean = False)
        Dim pair As Collection
        Dim additionalTerms As Collection
        Dim referencePairs As Collection
        Call XLSBuildLexicon
        Call SortLexiconTable("LexiconLengthZone")
        Set pair = XLSReplaceAllTermsInARange(cells, offset)
        Set additionalTerms = pair.Item("additionalTerms")
        Set referencePairs = pair.Item("referencePairs")
        If doColor Then
            Call XLSColorQuotedText(cells, Range("LexiconReplacementZone"))
        End If
        Call XLSAddGlossaryTerms(additionalTerms)
        If offset = 0 Then
            Call BuildInternalReferenceTable(referencePairs)
        End If
    End Sub
    
    ' Ctrl - r
    Sub XLSReplaceAllTermsInSelection()
        Call RedimGlossaryTableAndZones
        Call XLSReplaceAllTermsInRange(Selection, -5000, True)
    End Sub
    
    ' Ctrl - u
    Sub XLSReplaceAllTermsInGlossaryDefinitionZone()
        Call RedimGlossaryTableAndZones
        Call XLSReplaceAllTermsInRange(Range(kGlossaryDefinitionZone), 0, True)
    End Sub
    
    

        
    
    Sub XLSUpdateExportSheet()
        Call RedimGlossaryTableAndZones
        Dim export As Range
        Dim summary As Range
        Dim termIndex As Integer
        Set export = Sheets(kExportSheetName).cells
        Set summary = Range(kInternalReferenceSummaryTableZone)
        Call export.Columns.Clear
        For termIndex = 1 To summary.Rows.Count - 1 'because of header
            export.cells(termIndex, 1).value = summary.cells(termIndex + 1, kInternalReferenceSummaryTerm).value
            export.cells(termIndex, 2).value = summary.cells(termIndex + 1, kInternalReferenceSummaryDefinition).value
            export.cells(termIndex, 3).value = summary.cells(termIndex + 1, kInternalReferenceSummaryRefToTerms).value
        Next termIndex
    End Sub
    
    
    
    
    '========================================= LEXICON MANAGEMENT =========================================================
    
    Sub XLSPutItemInLexicon(nitem As Integer, term As String, glossaryTerm As String, glossaryId As Integer, targetCell As Range, _
                            isGlossaryTerm As Boolean, isPlural As Boolean, isSynonym As Boolean, isSubterm As Boolean, isComposedTerm)
        Dim termCell, refToGlossaryCell As Range
        Dim addressOfTargetCell As String
        Dim linkCell As Range
        Dim linkText As String
        Dim glossaryTermDefinition As String
        Dim replacementCell As Range
        
        Set termCell = Range("LexiconTermZone").Item(nitem)
        termCell.value = term
        Set refToGlossaryCell = Range("LexiconGlossaryTermZone").Item(nitem)
        addressOfTargetCell = kGlossarySheet & "!" & CStr(targetCell.Address(RowAbsolute:=True, ColumnAbsolute:=True))
        refToGlossaryCell.value = glossaryTerm
        ' glossaryTermDefinition = GetDefinition(nitem
        If (glossaryTerm <> "") Then
            Set linkCell = refToGlossaryCell
            linkText = glossaryTerm
            
        Else
            Set linkCell = termCell
            linkText = term
        End If
        Call ActiveSheet.Hyperlinks.Add(Anchor:=linkCell, _
                                         Address:="", _
                                         SubAddress:=addressOfTargetCell, _
                                         ScreenTip:="test", _
                                         TextToDisplay:=linkText)
        Range("LexiconIsGlossaryTermZone").Item(nitem).value = isGlossaryTerm
        Range("LexiconIsPluralZone").Item(nitem).value = isPlural
        Range("LexiconIsSynonymZone").Item(nitem).value = isSynonym
        Range("LexiconIsSubTermZone").Item(nitem).value = isSubterm
        Range("LexiconIsComposedTermZone").Item(nitem).value = isComposedTerm
        Range("LexiconLengthZone").Item(nitem).value = Len(term)
        Range("LexiconGlossaryIdZone").Item(nitem).value = glossaryId
        
        Set replacementCell = Range("LexiconReplacementZone").Item(nitem)
        If (isGlossaryTerm Or isPlural) Then
            replacementCell.value = kOpenTermChar & term & kCloseTermChar
        Else
            If (isSynonym) Then
                replacementCell.value = kOpenTermChar & glossaryTerm & " <= " & term & kCloseTermChar
            Else
                replacementCell.value = ""
            End If
        End If
    End Sub
    
    Sub ClearLexiconTableContent()
        Range("LexiconTableZone").offset(1).Clear
    End Sub
    Sub SortLexiconTable(zonename As String)
        Call Range("LexiconTableZone").Sort(Range(zonename), xlDescending)
    End Sub
    
    Sub XLSBuildLexicon()
        Dim lexiconTermCells As Range
        Dim glossaryTermCell As Range
        Dim lexiconTermCell  As Range
        Dim nbLexiconTerm As Integer
        Dim glossaryTermExpr, plural, singular As String
        Dim termExprParsed As Collection
        Dim iGlossaryTerm As Integer
        Set lexiconTermCells = Range("LexiconTermZone")
        lexiconTermCells.Clear
        nbLexiconTerm = 0
        
        Call ClearLexiconTableContent
                                         
        '----- Add all the glossary terms in their singular form
        iGlossaryTerm = 0
        For Each glossaryTermCell In Range(kGlossaryTermZone)
            iGlossaryTerm = iGlossaryTerm + 1
            Set glossaryTermExpr = GetSingularAndPlural(glossaryTermCell.value)
            singular = glossaryTermExpr.Item("singular")
            If (singular <> "") Then
                Call XLSPutItemInLexicon(nitem:=nbLexiconTerm + 1, term:=singular, glossaryTerm:="", glossaryId:=iGlossaryTerm, _
                                         targetCell:=glossaryTermCell, _
                                         isGlossaryTerm:=True, isPlural:=False, isSynonym:=False, _
                                         isSubterm:=False, isComposedTerm:=(InStr(1, singular, " ") >= 1))
                nbLexiconTerm = nbLexiconTerm + 1
            End If
        Next glossaryTermCell
        
        '---- Add all plurals based on glossary terms
        iGlossaryTerm = 0
        For Each glossaryTermCell In Range(kGlossaryTermZone)
            iGlossaryTerm = iGlossaryTerm + 1
            Set glossaryTermExpr = GetSingularAndPlural(glossaryTermCell.value)
            singular = glossaryTermExpr.Item("singular")
            plural = glossaryTermExpr.Item("plural")
            If (singular <> "" And plural <> "") Then
                Call XLSPutItemInLexicon(nitem:=nbLexiconTerm + 1, term:=(plural), glossaryTerm:=(singular), glossaryId:=iGlossaryTerm, _
                                        targetCell:=glossaryTermCell, _
                                        isGlossaryTerm:=False, isPlural:=True, isSynonym:=False, _
                                        isSubterm:=False, isComposedTerm:=(InStr(1, plural, " ") >= 1))
                nbLexiconTerm = nbLexiconTerm + 1
            End If
        Next glossaryTermCell
        
        
        '---- Add all subTerms of glossary terms
        '================= removed ===================
        If False Then
            Dim subTerms As New Collection
            Dim subTerm As Variant
            iGlossaryTerm = 0
            For Each glossaryTermCell In Range(kGlossaryTermZone)
                iGlossaryTerm = iGlossaryTerm + 1
                Set glossaryTermExpr = GetSingularAndPlural(glossaryTermCell.value)
                singular = glossaryTermExpr.Item("singular")
                If (singular <> "") Then
                    Set subTerms = AllSubTerms(singular)
                    For Each subTerm In subTerms
                    
                        Call XLSPutItemInLexicon(nitem:=nbLexiconTerm + 1, term:=(subTerm), glossaryTerm:=(singular), glossaryId:=iGlossaryTerm, _
                                            targetCell:=glossaryTermCell, _
                                            isGlossaryTerm:=False, isPlural:=False, isSynonym:=False, _
                                            isSubterm:=True, isComposedTerm:=(InStr(1, subTerm, " ") >= 1))
                        nbLexiconTerm = nbLexiconTerm + 1
                    Next subTerm
                End If
            Next glossaryTermCell
        End If
        
        '---- Add all synonyms of glossary terms
        Dim synonym As Variant 'Object string
        iGlossaryTerm = 0
        For Each glossaryTermCell In Range(kGlossaryTermZone)
            iGlossaryTerm = iGlossaryTerm + 1
            Set glossaryTermExpr = GetSingularAndPlural(glossaryTermCell.value)
            singular = glossaryTermExpr.Item("singular")
            For Each synonym In GetSynonyms(iGlossaryTerm)
                    Call XLSPutItemInLexicon(nitem:=nbLexiconTerm + 1, term:=(synonym), glossaryTerm:=(singular), glossaryId:=iGlossaryTerm, _
                                        targetCell:=glossaryTermCell, _
                                        isGlossaryTerm:=False, isPlural:=False, isSynonym:=True, _
                                        isSubterm:=False, isComposedTerm:=(InStr(1, synonym, " ") >= 1))
                    nbLexiconTerm = nbLexiconTerm + 1
            Next synonym
            
        Next glossaryTermCell
        Call XLSDimZone("LexiconTermZone", nbLexiconTerm)
        Call XLSDimZone("LexiconReplacementZone", nbLexiconTerm)
        Call XLSDimZone("LexiconTableZone", nbLexiconTerm, -1)
        Call XLSDimZone("LexiconLengthZone", nbLexiconTerm)
        
    '    Call range("LexiconTermZone").Rows.Offset(-1).Sort("R6C8", xlDescending)
    '    Call range("R6:R1000").Sort("R6C8", xlDescending)
    End Sub
    
    
    ' dico could be either null, a array of string, or a excel range (of cells)
    Sub XLSColorQuotedText(cells As Range, Optional dico As Variant = Null)
        Dim cell As Range
        Dim segments As Collection
        Dim cellText As String
        For Each cell In cells
            cellText = cell.value
            
            ' Parse the cellvalue
            Set segments = _
                SplitMultipleDelimiters(cellText, kOpenTermChar & kCloseTermChar & kExternalTermChar, kQuotingChar, True)
        
            ' Color the quoted text, that is the segments that are at odd positions
            Dim nSegment As Integer
            Dim text As String          ' Text of current segment
            Dim start As Integer        ' Start position of current segment
            Dim size As Integer         ' Length of current segment
            Dim isQuotedText As Boolean ' Is the current segment quoted
            Dim isInDico As Boolean     ' Is the current segement in the dictionnary
            Dim Color As Long
            Dim style As String
            Dim segment As Collection
            
            nSegment = 1
            
            For Each segment In segments
        
                text = segment.Item("text")
                size = Len(text)
                start = segment.Item("position")
                
                isQuotedText = nSegment Mod 2 = 0
                If (isQuotedText) Then
        
                    If Not IsNull(dico) Then
                        If IsObject(dico) Then
                            Dim targetCell As Range
                            Set targetCell = dico.Find(What:=kOpenTermChar & text & kCloseTermChar, _
                                                        LookIn:=xlValues, lookAT:=xlWhole, MatchCase:=False)
                            isInDico = Not (targetCell Is Nothing)
                        Else
                            If IsArray(dico) Then
                                isInDico = FindInArray(text, dico) <> -1
                            End If
                            isInDico = False
                        End If
                    End If
                
                    ' we add the preceding quote in the set of char to color
                    start = start - 1
                    size = size + 1
                    If (start + size <= Len(cellText)) Then
                        ' if there a final quote (it may not exist and the string may end abrubtly)
                        size = size + 1
                    End If
                    If Not IsNull(dico) And isInDico Then
                        Color = kBlue
                    Else
                        Color = kDarkRed
                    End If
                    style = "Bold"
                Else
                    Color = kBlack
                    style = ""
                End If
                Call XLSSetCellCharacters(cell, start, size, Color, style)
                nSegment = nSegment + 1
                        
            Next segment
        Next cell
    End Sub
    
    
    Sub XLSColorSelectedDefinitions()
      Call XLSColorQuotedText(Selection, Range("LexiconReplacementZone"))
    End Sub
    
    
    
    Sub XLSColorDefinitions()
        Call XLSColorQuotedText(Range(kGlossaryDefinitionZone), Range("LexiconReplacementZone"))
    End Sub
    
    
    
    
    
    
    
    
    
    
    
    '============================================== TEST =========================================
    
    ' Temporary macro to test the computation of plural
    Sub XSLPlural()
        Dim cell As Range
        Dim termExpr As String
        Dim c As Collection
        For Each cell In Range(kGlossaryTermZone)
            termExpr = cell.value
            Set c = GetSingularAndPlural(termExpr)
            Call cell.ClearComments
            Call cell.AddComment(c.Item("singular") & " / " & c.Item("plural"))
        Next cell
    End Sub
    
    ' Test rountine called with ctrl t
    Sub XLSTest()
        'Call XLSReplaceAllTermsByTheirIdInARange(Selection)
        'Dim term As String
        'Call ActiveCell.ClearComments
        'Call ActiveCell.AddComment(JoinCollection(AllSubTerms(ActiveCell), ", "))
        'Dim s As String
        's = JoinCollection(GetSynonyms(CInt(ActiveCell.Value)), ", ")
        'ActiveCell.AddComment (s)
        'Call XLSDimZone("DebugZone", 23)
       ' Call ActiveCell.AddComment(XLSReplaceAllTermsByTheirIdInARange)
       'g = g + 1
       'ActiveCell.value = g
       Call XLSUpdateExportSheet
    End Sub