Attribute VB_Name = "EspWSTAT"
'EspWSTAT          'ESPSOF Versio 0.95       Makroo-Modjulo uzebla de MS WORD           'ESPSOF Versio 0.95

'30 januaro 2009 TW (Toon Witkam)
'op 03-01-09 toegevoegd als 19e Subrutino:  iPosStartEndSelecteer
'op 12-12-08 toegevoegd als 23e Funkcio:  HaalMORDISweg
'anta�a versio:  3 Junio 2008 TW

'tiu chi modjulo entenas 42 procedurojn: 19 subrutinojn kaj 23 funkciojn;
'la subrutino 'AFMbazo' estas baza programo; ghi estas automate alvokita de la programo TEKSTanal (en modjulo EspKONTR);
'la subrutino 'KVEK' estas aplika programo (konkordancilo); antau ol alvoki ghin, alvoku 'AFMbazo'-on antaue;

'la ceteraj 37 proceduroj estas subordigitaj helpfunkcioj, au helpprogramoj uzeblaj por konverti diversajn literkodojn ( -h, -x, k.a.)
'al la ghustaj supersignitaj Esp-literoj (kongruaj al EK de Jurij Finkel) en Unikodo.


Option Explicit
'makes use of the Public variable (Boolean):  CalledByTekstAnal  '[10-3-2008]
'makes use of the Public variable (Integer):    statusEnigoTEKSTanal   '[1-5-08]
'makes use of the Public variable (Object):     EspsofExcel  '[10-5-08]
'makes use of the Public variable (String):      EspsofREGREZ  '[7-5-2008]
'makes use of the Public variable (Boolean):   TekstoKajNotojAparte  '[27-12-2008]
'makes use of the Public variable (Boolean):   FootnotesBeingProcessed As Boolean  '[27-12-2008]
'makes use of the Public variable (Boolean):   EndnotesBeingProcessed As Boolean  '[27-12-2008]
'makes use of the Public variable (Integer):     iNummer1eAlinea  '[3-6-2008]
'makes use of the Public variable (Integer):     nAantalAlineas  '[8-1-09]
'makes use of the Public variable (Integer):     iBasis1eAlinea  '[8-1-09]

'PRIVATE statische variabelen dienen alleen voor communicatie BINNEN de module EspWSTAT:
Private iPosSentenceStart As Long  '[3-1-09]
Private iPosSentenceEnd As Long  '[3-1-09]
Private nPosSentenceStartEnd As Long  '[3-1-09]






Sub AFMbazo()   'ESPSOF Versio 0.95
'30 januaro 2009 TW (Toon Witkam)

'AFM = Alineo- kaj Fraz-Markilo  (starigo de FrazKomencMarkoj)
'[antaua nederlandlingva nomo: AZM = 'AlineaEnZinsMarkeerder' ]

'La makroo AFMbazo estas la eka bazo por cxiuj aplikoj de la ESPSOF-softvaro de TW.
'Cxiu teksto estas unue pritraktenda de tiu cxi baza makroo, kiu detektas
'(kun pli granda precizeco ol MS Word mem) la LIMOJN de FRAZOJ,
'kaj aldonas indikilon (t.n. 'Field') antau cxiu frazkomenco. Tiu FrazKomencMarko entenas:
'   - aline-numeron;
'   - fraz-numeron;
'   - frazlongon (nombro de la vortoj en la frazo, pli precize ol MS Word mem indikus tion).

'La diversaj aplikoj de ESPSOF (TEKSTanal, KVEK) bezonas tiujn 'Field'-indikilojn, kaj foje
'servas la uzanton, per referencado al la aline- kaj fraznumeroj en esplorita teksto.
'La uzanto do mem profitos de tiuj aline- kaj fraznumeroj. Se la 'Field'-indikiloj estas ghenaj dum tekst-
'legado, la uzanto povas malshalti ilian videblecon per (en MS Word): 'Tools' - 'Options' - 'View' - 'Field codes'.

'En AFMbazo versio 0.8, la pritraktenda teksto povas enhavi aliajn 'Field'-indikilojn, kiel uzatajn por interret- kaj retposht-adresoj.
'Kelkgrade, ankau tabeloj kaj figuroj en la teksto eblas.

'AFMbazo kaj la ceteraj ESPSOF -programoj estas faritaj speciale por literaturaj tekstdosieroj. Figuroj, artajhoj, formuloj, tabeloj
'(cxu kun teksto, cxu kun ciferoj) ktp ne povas esti pritraktitaj kaj certagrade riskas malfunkciigi ESPSOF-on.
'AFMbazo 0.8 povas pritrakti (bluigitajn) interret- kaj retposht-adresojn en via teksto, sed nepre forigu el via tekstdosiero la ru�ajn
'revizikomentajhojn uzeblajn en MS-WORD.
'Uzo de piednotoj estas permesita, sed la tekstoj de la piednotoj mem ne estas prilaborita per AFMbazo 0.8.

'----------------------------------------------------
    
    Dim nFields As Integer
    Dim iZin As Integer
    Dim textfield As String
    Dim i As Integer
    Dim iVraag As Integer
    Dim iRoep As Integer
    Dim nFieldsPreview As Integer
    
    Dim AzmField As Object
    Dim WstatWordtoExcel As Object  '[21-4-08]
    Dim iField As Integer
    Dim nFieldLength As Integer
    Dim ZinsLengte(250) As Long    'frazlongeco maksimume 250 vortoj
    Dim nTotaalAantalZinnen As Long
    Dim WstatnTotaalAanZinslengten As Long
    Dim nZinsNummer As Integer     'zinsnummer binnen een alinea
    Dim nControleTotaalAantalZinnen As Long
    Dim nControleTotaalAanZinslengten As Long
    Dim GemiddeldeZinslengte As Single
    Dim WstatnTotaalAanKwadraten As Long
    Dim StandaardDeviatie As Single
    Dim Imin As Integer
    Dim Imax As Integer
    'Dim nAantalAlineas As Integer  '[5-1-09] nu Public, ivm aparte oproepen (door TEKSTanal) van AFMbazo, maar met doortelling Alineanummers bij wisseling MainText, Footnotes, Endnotes
    'Dim iBasis1eAlinea As Integer  '[6-1-09] nu Public, ivm nAantalAlineas
    Dim Getalinvoer As String
    Dim iGetalinvoer As Integer
    Dim nWordsPerSentence As Long  '[1-4-08]
    Dim iNonWord As Integer
    Dim nGapNaPuntOfPar As Integer
    Dim nGapVoorPar As Integer
    Dim nPreviousGapLength As Integer
    Dim iOpeningsLeesTeken As Integer
    Dim iSluitingsLeesTeken As Integer
    Dim ChLowerCase As Boolean
    'Dim iPosSentenceStart As Long   '[3-1-09] nu PRIVATE, positie van eerste teken van een zin (meestal voor de beginhoofdletter);
    'Dim iPosSentenceEnd As Long    '[3-1-09] nu PRIVATE, positie van laatste teken van een zin (meestal achter de punt);
    Dim iPosCheck As Long  '[8-1-09] om te checken of een Selection niet "aanbotst" tegen het File-begin
    Dim iPosCheckLaatste As Long  '[5-1-09]
    Dim iPosCursorNaPunt As Long
    Dim iPosCursorNaApenstaart As Long
    Dim nGapLength As Integer       'zgn. 'gap' (spatie, linefeeds e.d.) tussen 2 zinnen.
    Dim VraagUitroep As Boolean
    Dim nPuntjes As Integer
    Dim SentenceRange As Range
    Dim DummyRange As Range
    Dim ch As String
    Dim Ch1 As String
    Dim Ch2 As String
    Dim Ch3 As String
    Dim Ch4 As String
    Dim ChFound As String
    Dim nZinsBeginZonderSpatie As Integer
    Dim VaakZinsBeginZonderSpatie As Boolean
    Dim EersteParagraphTeken As Boolean
    Dim MsgBox1eAlineaShown As Boolean
    Dim TeBewerkenFieldCode As String
    Dim WegTeHalenString As String
    Dim h As String
    Dim i1 As Integer  '[21-4-08]
    Dim iKopOfTussenkop As Integer  '[21-4-08]
    Dim nPreviousAantalAlineas As Integer  '[21-4-08]
    Dim nPrePreviousAantalAlineas As Integer  '[21-4-08]
    Dim nPrePreviousGapLength As Integer  '[21-4-08]
    Dim nPreviousWordsPerSentence As Integer  '[21-4-08]
    Dim nLengteBlokVoorKop As Integer  '[21-4-08]
    Dim nPreviousTotaalZinslengten As Long  '[24-4-08]
    Dim MainText As Boolean  '{9-1-09]
    Dim LaatsteZinInMainText As Boolean  '[5-1-09]
    Dim LaatsteZinInFootnotes As Boolean  '[5-1-09]
    Dim LaatsteZinInEndnotes As Boolean  '[29-1-09]
    Dim FirstFieldFootnotes As Boolean  '{8-1-09]
    Dim FirstFieldEndnotes As Boolean  '[29-1-09]
    Dim FootOrEndNoteMark As Boolean  '[29-1-09]
    Dim nTables As Integer  '[7-1-09]
    Dim nCommentsInDoc As Integer  '[27-1-09]
'
    nGapLength = 1
    EersteParagraphTeken = True  '[19-3-2007]
    MainText = Not (FootnotesBeingProcessed Or EndnotesBeingProcessed)  '[9-1-09]
    WegTeHalenString = " \* MERGEFORMAT "  'visueel hinderlijke string in elk Field

    Selection.Find.ClearFormatting     'reset eventuele eerdere instellingen van Find
    
    
'   Verwijderen van evt. (resterende) Review Comments in de WORD-file  [27-1-09]:
    'WordBasic.DeleteAllCommentsInDoc
    nCommentsInDoc = ActiveDocument.Comments.Count
    If nCommentsInDoc > 0 Then
        MsgBox "there are Review Comments in your WORD-file;  they will be deleted"
        For i = 1 To nCommentsInDoc
            ActiveDocument.Comments(1).Delete  '[27-1-09]:
        Next i
    End If


'   Het altijd zichtbaar maken van FieldCodes (indien dit niet reeds door de gebruiker in MS Word via het Tools-Options menu gedaan is)
'   is essentieel voor de goede werking van het macro:
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True    '[14-10-2004 ]
    
'   Check op reeds aanwezig zijn van AZM-Fields:   '[22-2-2008]
        'nFields = ActiveDocument.Fields.Count
        If MainText Then  '[27-12-08]
            nFields = ActiveDocument.StoryRanges(wdMainTextStory).Fields.Count
        ElseIf FootnotesBeingProcessed Then
            nFields = ActiveDocument.StoryRanges(wdFootnotesStory).Fields.Count
        ElseIf EndnotesBeingProcessed Then
            nFields = ActiveDocument.StoryRanges(wdEndnotesStory).Fields.Count
        End If
        If nFields = 0 Then GoTo 49  'helemaal geen Fields in file-deel (MainText, Footnotes, Endnotes)
        nFieldsPreview = nFields
        If nFieldsPreview > 10 Then nFieldsPreview = 10  'ga na of al bij de eerste 10 Fields AZM-Field (FrazKomencMarko) is:
        For iZin = 1 To nFieldsPreview  '(de loopvariabele iZin hoeft hier nog niet per se op achtereenvolgende zinnen te slaan)
                If MainText Then  '[30-1-09]
                    ActiveDocument.StoryRanges(wdMainTextStory).Fields(iZin).Select   '[30-1-09]
                    textfield = ActiveDocument.Fields(iZin).Code.Text   'AZM-Field is herkenbaar aan voorkomen van "-" en ".,"
                    If InStr(2, textfield, "-") > 0 And InStr(4, textfield, ".,") > 0 Then  'tenminste 1 AZM-field in deze file
                        'MsgBox ("AZM-plus" & vbCr & vbCr & "reeds AZM-Fields aangetroffen in deze file")  '23-2-2008
                        If MsgBox("Chi tiu fontotekst-dosiero estas jam antau-pritraktita de ESPSOF," & vbCr & _
                        "char ghi entenas FRAZKOMENC-MARKOJN (kun indikoj de FRAZLONGECOJ)   -   " & vbCr & _
                        "                                          chu ankorau re-uzi tiujn?", vbYesNo, _
                        Title:="EspWSTAT.AFMbazo") = vbYes Then GoTo 1099  'nieuwe doorloop AFM-bazo is NIET nodig
                    End If
                ElseIf FootnotesBeingProcessed Then
                    ActiveDocument.StoryRanges(wdFootnotesStory).Fields(iZin).Select   '[30-1-09]
                    textfield = ActiveDocument.Fields(iZin).Code.Text   'AZM-Field is herkenbaar aan voorkomen van "-" en ".,"
                    If InStr(2, textfield, "-") > 0 And InStr(4, textfield, ".,") > 0 Then  'tenminste 1 AZM-field in deze file
                        'MsgBox ("AZM-plus" & vbCr & vbCr & "reeds AZM-Fields aangetroffen in deze file")  '23-2-2008
                        If MsgBox("La PIEDNOTOJ de la dosiero estas jam antau-pritraktitaj de ESPSOF," & vbCr & _
                        "char ili entenas FRAZKOMENC-MARKOJN (kun indikoj de FRAZLONGECOJ)   -   " & vbCr & _
                        "                                          chu ankorau re-uzi tiujn?", vbYesNo, _
                        Title:="EspWSTAT.AFMbazo") = vbYes Then GoTo 1099  'nieuwe doorloop AFM-bazo is NIET nodig
                    End If
                ElseIf EndnotesBeingProcessed Then
                    ActiveDocument.StoryRanges(wdEndnotesStory).Fields(iZin).Select   '[30-1-09]
                    textfield = ActiveDocument.Fields(iZin).Code.Text   'AZM-Field is herkenbaar aan voorkomen van "-" en ".,"
                    If InStr(2, textfield, "-") > 0 And InStr(4, textfield, ".,") > 0 Then  'tenminste 1 AZM-field in deze file
                        'MsgBox ("AZM-plus" & vbCr & vbCr & "reeds AZM-Fields aangetroffen in deze file")  '23-2-2008
                        If MsgBox("La FINAJ NOTOJ de la dosiero estas jam antau-pritraktitaj de ESPSOF," & vbCr & _
                        "char ili entenas FRAZKOMENC-MARKOJN (kun indikoj de FRAZLONGECOJ)   -   " & vbCr & _
                        "                                          chu ankorau re-uzi tiujn?", vbYesNo, _
                        Title:="EspWSTAT.AFMbazo") = vbYes Then GoTo 1099  'nieuwe doorloop AFM-bazo is NIET nodig
                    End If
                End If
                'if vbNo:
                GoTo 7
        Next iZin
        'bij eerste 10 Fields vooralsnog GEEN AZM-Field (FrazKomencMarko) aangetroffen; indien die verderop toch in de file staan, ...
        '... dan worden ze weggehaald (alsof de gebruiker 'revizio' gewenst had)
        
7:
    'Cursor zetten op beginpositie file:
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endmotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If

    'Terugbrengen van evt. HYPERLINK- (en HYPERTEXT- ?) Fields tot gewone stukjes tekst, oftewel "unlinken"
    '(Hyperlink-Fields mogen niet gedelete worden, want dan zou de websitenaam die daar in staat verloren gaan):
    nFields = ActiveDocument.Fields.Count
    For iZin = 1 To nFields  '(ons doel is dat met elk (AZM-)Field precies 1 zin zal corresponderen)
        'ActiveDocument.Fields(iZinMinusReedsWeggehaaldeFields).Select   'geeft problemen bij de telling: ...
        '... subscript in dit stmt zou terug moeten lopen met het aantal weggehaalde Fields, maar de telling daarvan ...
        '... wordt gecompliceerd doordat er ook Fields in de file zitten die bij de Field-count meegeteld zijn, maar...
        '... die niet weggehaald worden door het 'Unlink'-stmt: Index Fields en mogelijk andere Fields.
        'Daarom wordt ipv met 'ActiveDocument.Fields(iZinMinus...).Select' met de hieronderstaande "wdGoToField" gewerkt:
        Selection.GoTo what:=wdGoToField    'werkt alleen op hyperlinks en (misschien?) op hypertext; NIET op Index Fields
                                                                'werkt WEL (incl. verwijdering) op AZM-Fields, behalve op het allereerste, ...
                                                                '...als die allereerste geheel vooraan in de file staat, zonder ook maar enige spatie of wat dan ook ervoor!
        Selection.Expand unit:=wdWord
        Selection.Fields.Unlink    'werkt alleen op hyperlinks en (misschien?) op hypertext; NIET op Index Fields
        Selection.Collapse direction:=wdCollapseEnd
        Selection.MoveEnd unit:=wdCharacter, Count:=1
    Next iZin

    'Nu alle vroegere AZM-fields en verdere nog resterende Fields (bijv. Index-Fields, ...) VERWIJDEREN:
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True  '(het zichtbaar zijn van de Fields is een voorwaarde voor het kunnen weghalen!)  '[12-2-2008]
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^d"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


49:

'   Controle op aanwezigheid van VRAAGTEKENS in de hele file:
'   (Vraagtekens zijn van belang als mogelijke zinsgrens, maar vormen een complicatie
'   bij het verfijnd opsporen daarvan, doordat ze 'botsen' met de wildcard-syntax van FIND.
'   Daarom worden ze tijdens de uitvoering van dit macro tijdelijk vervangen door
'   Pound-Sterling tekens):
'   Beginpositie cursor (zet cursor aan begin file):       '[26-2-2008:] dit is niet overbodig!
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If
    
    iVraag = 0
    For i = 1 To 5000 'aanname: geen tekstfile heeft meer dan 5000 vraagtekens
    With Selection.Find
        .Text = "?"
        .Replacement.Text = "�"  'Pound-Sterling teken, ASCII-code 163 (Latin-1, Basic-Latin)
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = False
        .Execute Replace:=wdReplaceOne   'DEZE REGEL IS ESSENTIEEL OM REPLACE TE EFFECTUEREN!!
    End With
    If Selection.Find.Found = False Then GoTo 1009   'laatste vraagteken is vervangen
    iVraag = iVraag + 1
    Selection.MoveRight unit:=wdCharacter, Count:=1  '(ANDERS VINDT' IE ALLEEN MAAR DIE ENE!!)
    Next i
'   (einde vervanging vraagtekens)
1009:
'
'
'   Controle op aanwezigheid van UITROEPTEKENS in de hele file:
'   (Uitroeptekens zijn van belang als mogelijke zinsgrens, maar vormen een complicatie
'   bij het verfijnd opsporen daarvan, doordat ze 'botsen' met de wildcard-syntax van FIND.
'   Daarom worden ze tijdens de uitvoering van dit macro tijdelijk vervangen door
'   dollarcent-tekens):
'   Beginpositie cursor (zet cursor weer aan begin file):
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If
    
    iRoep = 0
    For i = 1 To 5000 'aanname: geen tekstfile heeft meer dan 5000 uitroeptekens
    With Selection.Find
        .Text = "!"
        .Replacement.Text = "�"  'dollarcent-teken, ASCII-code 162 (Latin-1, Basic-Latin)
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = False
        .Execute Replace:=wdReplaceOne  'DEZE REGEL IS ESSENTIEEL OM REPLACE TE EFFECTUEREN!!
    End With
    If Selection.Find.Found = False Then GoTo 1010   'laatste uitroepteken is vervangen
    iRoep = iRoep + 1
    Selection.MoveRight unit:=wdCharacter, Count:=1  '(ANDERS VINDT' IE ALLEEN MAAR DIE ENE!!)
    Next i
'   (einde vervanging uitroeptekens)
1010:
    'MsgBox "Begin AZM-Plus" & vbCr & vbCr & _
                  iVraag & " vraagtekens tijdelijk vervangen door �" & vbCr & _
                  iRoep & " uitroeptekens tijdelijk vervangen door �"
'
'
'------------------------------------------------------------------------------------------------------------------------------------------------------------
'Het aanbrengen van AZM-Fields wordt nu verder voorbereid:                                                   '[23-2-2008]
'------------------------------------------------------------------------------------------------------------------------------------------------------------
  
   Set WstatWordtoExcel = GetObject(EspsofREGREZ)   '[21-4-08]
       'ATTENTIE: de Excel-file met deze naam moet wel tevoren GEOPEND zijn
    With WstatWordtoExcel
        For i = 16 To 20  'SCHOONVEGEN 5 kolommen (P t/m T) van Worksheet5, met Kopregel-indicaties:  '[21-4-08]
            .worksheets(5).Columns(i).ClearContents     'Zinsbouw
        Next i
    End With
    i1 = 1  '[21-4-08]
    
'   Evt. Toevoeging van 1 extra paragraafteken aan file-einde maakt AZM fool-proof [14-10-2004]   '[30-7-2007: alleen indien nodig]
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToLast
    'Cursor zetten op eindpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseEnd
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor worden alle Footnotes-teksten geselecteerd
        Selection.Collapse direction:=wdCollapseEnd
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor worden alle Endnotes-teksten geselecteerd
        Selection.Collapse direction:=wdCollapseEnd
    End If
    Selection.MoveEnd unit:=wdCharacter, Count:=1   '[30-7-2007]
    If Selection.Text <> vbCr Then   '[30-7-2007]
        Selection.Collapse
        Selection.MoveRight unit:=wdSentence, Count:=10000, Extend:=wdMove
        Selection.TypeText vbCr
    End If
    
'   Beginpositie cursor (zet cursor weer aan begin file):   '[3-1-09]
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor worden alle Footnotes-teksten geselecteerd
        Selection.Collapse direction:=wdCollapseStart
        FirstFieldFootnotes = True  '[8-1-09]
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor worden alle Endnotes-teksten geselecteerd
        Selection.Collapse direction:=wdCollapseStart
        FirstFieldEndnotes = True  '[29-1-09]
    End If
    
'   Conversie van Eventuele tekst-in-Tables (MS Word) structuur naar Gewone Tekst-Structuur: (MS Word):     [6-2-2007]
    If MainText Then
        Set DummyRange = ActiveDocument.Range(Start:=0, End:=0)  '[deze Dummy-constructie is nodig omdat bij geheel ontbreken van tekst-in-Tables...
        ActiveDocument.Tables.Add Range:=DummyRange, NumRows:=1, NumColumns:=1  '...onderstaande stmts op een Error zouden lopen]
        ActiveDocument.Tables(1).ConvertToText Separator:=wdSeparateByTabs  '[dit stmt voorkomt onjuiste werking van Selection.Find onder label 100]
        ActiveDocument.Range(Start:=0, End:=0).Delete  '[6-1-09]
        nTables = ActiveDocument.Tables.Count
        For i = 1 To nTables  '(bij nTables=0 gebeurt er niets)
            ActiveDocument.Tables(1).ConvertToText Separator:=wdSeparateByTabs  '[7-1-09]  'conversie van een Table naar text  '[26-1-09: Tables(1) ipv Tables(i)]
        Next i
    End If
'

'   Ga op zoek naar eerste tekst (letters) in het document:
'   tel de daaraan voorafgaande spaties, tabs, linefeeds, manual page breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen max. aantal!),
'   ook:  ----  ++++  ==== underscore en sterretjes,  en bovendien: loslopende punten,
'   komma's, dubb.punten, en puntkomma's (ook in reeksen), alsmede het sprekerswisselingsteken (lange streep, = ChrW(8212)):
    nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" .,:;" & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
    nPreviousGapLength = nGapNaPuntOfPar
    If MainText Then
        iPosSentenceStart = Selection.Characters(1).Start
    Else  'If Footnotes or Endnotes  [27-12-08]:
        Selection.MoveEnd unit:=wdCharacter, Count:=1
        i = 0
81:    Selection.MoveStart unit:=wdCharacter, Count:=1
        Selection.MoveEnd unit:=wdCharacter, Count:=1
        If Selection.Text <> " " Then
            i = i + 1
            If i > 3 Then MsgBox "Footnotes or Endnotes with markings of more than 3 digits or other signs cannot be processed correctly"  '[27-12-08]
            GoTo 81
        Else  'space (after Footnote-marking) has been reached:
            Selection.Collapse direction:=wdCollapseEnd     '[27-12-08]
            iPosSentenceStart = Selection.Characters(1).Start
        End If
    End If
    
' De standaard zinsgrensbepaling van VBA voldoet niet en wordt niet meer gebruikt.
' Bij de hier zelfgeprogrammeerde ZINSGRENS-afbakening wordt door het hele macro heen gewerkt met:
'   - SentenceRange: het bereik van de actuele zin waaraan gewerkt wordt;
'   - iPosSentenceStart:  begin- [let op: dit is om precies te zijn de positie VOOR het eerste teken van de zin!] en
'   - iPosSentenceEnd:   eind-positie [meestal de punt] van de actuele zin,
'                         uitgedrukt in absolute character-posities t.o.v. begin van file-'Story' (MainText, FootNotes, EndNotes)
'


100:
    With Selection.Find  'het zoeken van mogelijke zinsbeeindigingstekens:
        .Text = "[.��:;|" & Chr(13) & "]"   'ASCII-teken 13 is: CR oftewel Paragraph-teken;
'       alle vraag- en uitroeptekens in de file zijn aan het begin van dit macro vervangen door resp.
'       Pound-Sterling tekens en dollarcent-tekens (ASCII-codes Latin-1 resp. 163 en 162);
        ' er zijn dus 7 tekens die een zinsgrens KUNNEN triggeren, afhankelijk van
        ' hieronder voor elk van de 7 uitgewerkte condities:
        .Forward = True
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With
    VraagUitroep = False
    Selection.Find.Execute
'
'   In geheugen bewaren van sentence-range behorend bij deze (Zinsgrens-)FIND:
    iPosSentenceEnd = Selection.Characters(1).End   'meestal is dit de positie van de zinseinde-punt.
    If MainText Then   '[27-12-08]
        Set SentenceRange = ActiveDocument.Range(Start:=iPosSentenceStart, End:=iPosSentenceEnd)
    End If
    'bij Footnotes of Endnotes zorgen 'iPosSentenceStart' en 'iPosSentenceEnd' in combinatie met ...
    ' ... subroutine iPosStartEndSelecteer voor het kunnen reconstrueren van de sentence-range  '[29-1-09]
'
'
'
' Specificatie van ZINSGRENS-condities:
'
'
110:
    'PUNT:
    If Selection.Text = "." Or VraagUitroep = True Then
        'tel na de punt komende spaties, tabs, linefeeds, manual page-breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen maximum aantal!),
        'en bovendien:  ---- , ++++ , ==== , underscore, sterretjes, evt. voetnootnummer [Chr(2)], en sprekerswisselingsteken ChrW(8212):
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212) & Chr(2))
        
        If nGapNaPuntOfPar = 0 Then GoTo 11   'GEEN spatie na punt, betekent wschl: GEEN ZINSGRENS;
113: Selection.MoveStart unit:=wdCharacter, Count:=-1
        Selection.Next(unit:=wdCharacter, Count:=1).Select  'eerste teken na de spatie(s), tabs, linefeeds etc;
        If Selection.Characters(1).Case = wdUpperCase Then GoTo 18  'bij HOOFDLETTER na punt en spatie: wschl ZINSGRENS
        If Selection.Characters(1).Text = Chr(91) Then GoTo 20  'bij RECHTE OPENINGSHAAK na punt en spatie: ZINSGRENS  '[26-1-09]
        ch = Selection.Characters(1).Text   'Ch kandideert als beginteken van een nieuwe zin;
        If ch = Chr(123) Then  '[invoeging PLUS-versie:] openingsaccolade metatekst
            'MsgBox ("openingsaccolade metatekst;  nGapTotHier= " & nGapNaPuntOfPar) '['test PLUS-versie]
            nGapNaPuntOfPar = nGapNaPuntOfPar + Selection.MoveUntil(Cset:=Chr(125)) + 1  'skip alles tot sluitingsaccolade metatekst
            'MsgBox ("sluitingsaccolade metatekst;  nGapTotHier= " & nGapNaPuntOfPar)  '['test PLUS-versie]
            Selection.MoveStart unit:=wdCharacter, Count:=-1
            Selection.Next(unit:=wdCharacter, Count:=1).Select  'sluitingsaccolade metatekst
            nGapNaPuntOfPar = nGapNaPuntOfPar + Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
            'MsgBox ("nGapTotaal= " & nGapNaPuntOfPar)  '['test PLUS-versie]
            GoTo 113
        End If  '[einde invoeging PLUS-versie]
        If ch = "." Then GoTo 12   'punt na spaties na punt (gespatieerde ellipsis of loslopende punten(reeksen));
        'indien na de rits van spaties etc. een tekst met een kleine letter of met een cijfer (ASCII-code 48 t/m 57) begint,
        'en daar bovendien een paragraafteken aan voorafgaat, dan wordt dit als nieuwe zin beschouwd:
        ChLowerCase = False
        If Selection.Characters(1).Case = wdLowerCase Then ChLowerCase = True
        Selection.Next(unit:=wdCharacter, Count:=-1).Select  'laatste teken van de spatie(s), tabs, linefeeds etc;
        If Selection.Characters(1).Text = vbCr And _
          (ChLowerCase = True Or (Asc(ch) >= 48 And Asc(ch) <= 57)) Then GoTo 20 'ZINSGRENS
        Selection.Next(unit:=wdCharacter, Count:=1).Select  'terugzetten op eerste teken NA de spatie(s), tabs etc;
        'Test op evt. leestekens (openingshaken, apostrophen, Spaanse-?!) aan begin zin:
            iOpeningsLeesTeken = 0
1107:       iOpeningsLeesTeken = iOpeningsLeesTeken + 1
            'Openingsleestekens kunnen zijn:  ( [ < ' " alsmede dubb.spitse openingshaak en omgekeerde Spaanse ? !
            If (ch = "(" Or ch = "[" Or ch = "<" Or ch = Chr(171) Or ch = "'" Or ch = Chr(34) Or ch = Chr(191) Or ch = Chr(161) Or ch = ChrW(8220) Or ch = ChrW(8222)) _
                And iOpeningsLeesTeken <= 3 Then  'Chr(171) is dubb.spitse openingshaak; Chr(34) dubb.apostroph; 191 en 161: Spaans; '*ChrW(8220 en 8222) toegevoegd op 2-5-05
                Selection.Next(unit:=wdCharacter, Count:=1).Select   'ga naar het teken rechts daarvan:
                If Selection.Characters(1).Case = wdUpperCase Then GoTo 20  'ZINSGRENS
                'Na openingshaak/apostrophe/Spaanse-?! komt geen hoofdletter:
                ch = Selection.Characters(1).Text   'misschien NOG een openingshaak etc. (max. 3)
                'MsgBox "Openingshaken-Loop doorgang " & iOpeningsLeesTeken
                GoTo 1107
            End If
            'na punt-spatie[s] geen hoofdletter, geen tweede punt, geen openingshaak/apostrophe/Spaanse-?!), maar:
            'ofwel een ander leesteken (komma, kommapunt, dubbele punt...),
            'ofwel een kleine letter of cijfer zonder voorafgaand paragraafteken;
            GoTo 15    'GEEN zinsgrens (na 3 openingshaken/apostrophen/Spaanse-?! nog geen hoofdletter!)
11:   'Uitzonderingen  (GEEN spatie na punt):
        Selection.MoveStart , -1
        Selection.Next(unit:=wdCharacter, Count:=1).Select
        ch = Selection.Characters(1).Text
        'ELLIPSIS: puntjes-op-een-rij ZONDER spaties ertussenin:
        If ch = "." Then   'twee puntjes vlak achter elkaar;
            'ga met MoveWhile over verdere punten heen (geen max., en slechts 2 punten mag ook):
            nPuntjes = 2 + Selection.MoveWhile(Cset:=".")
            If nPuntjes > 2 Then Selection.Next(unit:=wdCharacter, Count:=-1).Select
            'het laatste puntje van de reeks wordt nu de nieuwe kandidaat zinseinde-punt:
            iPosSentenceEnd = iPosSentenceEnd + nPuntjes - 1
            If MainText Then Set SentenceRange = ActiveDocument.Range(Start:=iPosSentenceStart, End:=iPosSentenceEnd)  '[16-1-09]
            'SentenceRange.SetRange Start:=iPosSentenceStart, End:=iPosSentenceEnd  '[27-12-08]
            GoTo 110 'voorlopig beschouwen als ZINSGRENS
         End If
         'Andere uitzonderingen:
         If ch = "," Or ch = ";" Or ch = ":" Then GoTo 15 'GEEN zinsgrens
         'dekt combinaties als  .,  .;  .: in "etc.,"  "enz.;"  "bijv.:"
         
         'Letter (kleine letter of hoofdletter) direct na Punt  [uitzondering toegevoegd 18-12-2006]:
         'Punt maakt deel uit van een Website-naam:
         'Website-naam (URL) kan volledig zijn ( "www.websitenaam.abc" ) of kortweg "websitenaam.abc";    de extensie "abc"  kan uit 2 of 3 letters bestaan:
         If Letter(ch) Then       'Websitenaam of Email-adres kan met kleine letter of hoofdletter beginnen:
            'if www ervoor...
            Selection.MoveStart , -4
            Ch1 = Selection.Characters(1).Text
            Ch2 = Selection.Characters(2).Text
            Ch3 = Selection.Characters(3).Text
            Selection.MoveStart , 4
            If Ch1 = "w" And Ch2 = "w" And Ch3 = "w" Then GoTo 15    ' www....   dus GEEN zinsgrens
            'of (als geen www ervoor):  if "abc" begint met kleine letter, is 2 of 3 letters lang en is = "com" or "org" or "eu" or landsnaamafkorting...
            If KleineLetter(ch) Then
                Selection.MoveEnd , 3
                Ch1 = Selection.Characters(1).Text
                Ch2 = Selection.Characters(2).Text
                Ch3 = Selection.Characters(3).Text
                Ch4 = Selection.Characters(4).Text
                Selection.MoveEnd , -3
                If ((Ch1 & Ch2 & Ch3 = "com" Or Ch1 & Ch2 & Ch3 = "org") And Not Letter(Ch4)) Or _
                ((Ch1 & Ch2 = "nl" Or Ch1 & Ch2 = "be" Or Ch1 & Ch2 = "fr" Or Ch1 & Ch2 = "de" Or Ch1 & Ch2 = "uk" Or Ch1 & Ch2 = "dk" Or _
                Ch1 & Ch2 = "cz" Or Ch1 & Ch2 = "at" Or Ch1 & Ch2 = "ch" Or Ch1 & Ch2 = "hu" Or Ch1 & Ch2 = "pl" Or Ch1 & Ch2 = "ru" Or _
                Ch1 & Ch2 = "cn" Or Ch1 & Ch2 = "us" Or Ch1 & Ch2 = "it" Or Ch1 & Ch2 = "sp" Or Ch1 & Ch2 = "se" Or Ch1 & Ch2 = "co") And _
                Not Letter(Ch3)) Then GoTo 15    'GEEN zinsgrens
            End If
            
            'In sommige (HTML-afkomstige) teksten volgt een nieuwe zin zonder spatie op de voorafgaande:
            If Hoofdletter(ch) Then
               'if minimaal 2 kleine letters voor de punt    Then if MsgBox ("Spaceto mankas. Chu tamen frazlimo?", vbyesno) = vbyes Then dit is toch ZINSGRENS!
               Selection.MoveStart , -3
               Ch1 = Selection.Characters(1).Text
               Ch2 = Selection.Characters(2).Text
               Selection.MoveStart , 3
               If VaakZinsBeginZonderSpatie Then  '(aantal gevallen van ZinsBeginZonderSpatie is al groter dan 4):
                        If KleineLetter(Ch1) And KleineLetter(Ch2) Then GoTo 114  'voor de punt moeten minstens twee letters staan, zo niet dan...
                        For ibeepfreq = 600 To 100 Step -20
                            BeepAPI ibeepfreq, 20    'omlaaggaand audio-signaal
                        Next ibeepfreq
                        If MsgBox("Spaceto mankas. Chu tamen frazlimo?", vbYesNo, "EspWSTAT.AFMbazo") = vbYes Then GoTo 114  ' ...wordt toch de gebruiker geraadpleegd
               ElseIf nZinsBeginZonderSpatie = 4 Then
                        For ibeepfreq = 600 To 100 Step -20
                            BeepAPI ibeepfreq, 20    'omlaaggaand audio-signaal
                        Next ibeepfreq
                        If MsgBox("Spaceto mankas. Chu tamen frazlimo?" & vbCr & "Chu similajn kazojn estonte pritrakti kiel frazlimojn?", vbYesNo, "EspWSTAT.AFMbazo") = vbYes Then
                             VaakZinsBeginZonderSpatie = True
                             GoTo 114
                        Else
                               For ibeepfreq = 600 To 100 Step -20
                                   BeepAPI ibeepfreq, 20    'omlaaggaand audio-signaal
                               Next ibeepfreq
                               If MsgBox("Spaceto mankas. Chu en tiu chi sola kazo tamen frazlimo?", vbYesNo, "EspWSTAT.AFMbazo") = vbYes Then GoTo 114
                        End If
               Else  'nZinsBeginZonderSpatie = 4:
                       If KleineLetter(Ch1) And KleineLetter(Ch2) Then  'voor de punt moeten minstens twee letters taan
                                'If MsgBox("Spaceto mankas. Chu tamen frazlimo?", vbYesNo) = vbYes Then GoTo 114
                                GoTo 114
                       End If
               End If
            End If
         End If
         GoTo 116
114:
        'Kennelijk vergeten spatie voor zinsbegin alsnog INVOEGEN achter de punt:
        Selection.TypeText " "
        nGapNaPuntOfPar = 1
        'Set SentenceRange = ActiveDocument.Range(Start:=iPosSentenceStart, End:=iPosSentenceEnd)
        nZinsBeginZonderSpatie = nZinsBeginZonderSpatie + 1
        GoTo 20   'dit is toch ZINSGRENS   '[einde toevoeging 18-12-2006]
         
         'De punt kan worden gevolgd door een: sluithaak ) ] > of (dubb.) apostroph (max. 3):
116:     iSluitingsLeesTeken = 0     'alsmede door dubb.spitse sluithaak of door voetnootnummer
117:     iSluitingsLeesTeken = iSluitingsLeesTeken + 1   'Chr(2) is voetnootnummer, en wordt als 'Sluitingsleesteken' behandeld
         If (ch = ")" Or ch = "]" Or ch = ">" Or ch = Chr(187) Or ch = "'" Or ch = Chr(34) Or ch = Chr(2) Or ch = ChrW(8221) Or ch = ChrW(8223)) _
             And iSluitingsLeesTeken <= 3 Then       'Chr(187) is dubb.spitse sluithaak   '*ChrW(8221 en 8223) toegevoegd op 2-5-05
             Selection.Next(unit:=wdCharacter, Count:=1).Select
             ch = Selection.Characters(1).Text
             If ch <> " " And ch <> Chr(160) And ch <> vbTab And ch <> vbLf And ch <> Chr(11) _
             And ch <> vbCr And ch <> vbCrLf Then GoTo 117 'geen spatie etc, maar misschien zijn er meer sluithaken
             'Na de sluithaak (en/of voetnootnummer) is een spatie of paragraafteken, linefeed etc. ontdekt:
             Selection.Next(unit:=wdCharacter, Count:=1).Select
             'Hoofdletter na-spatie/etc-na sluithaak(en) na punt (of vraag/uitroepteken) betekent ZINSGRENS
             If Selection.Characters(1).Case = wdUpperCase Then GoTo 1120  'ZINSGRENS
             'maar.... hoofdletter kan worden voorafgegaan door openingshaken, apostr., Spaanse vraagteken...
             ch = Selection.Characters(1).Text     'ander teken na de spatie etc.
             'Openingshaak(en) na sluithaak(en):
             iOpeningsLeesTeken = 0
1176:        iOpeningsLeesTeken = iOpeningsLeesTeken + 1
            'Openingsleestekens kunnen zijn:  ( [ < ' " alsmede dubb.spitse openingshaak en omgekeerde Spaanse ? !
            If (ch = "(" Or ch = "[" Or ch = "<" Or ch = Chr(171) Or ch = "'" Or ch = Chr(34) Or ch = Chr(191) Or ch = Chr(161) Or ch = ChrW(8220) Or ch = ChrW(8222)) _
                And iOpeningsLeesTeken <= 3 Then  'Chr(171) is dubb.spitse openingshaak; Chr(34) dubb.apostroph; 191 en 161: Spaans; '*ChrW(8220 en 8222) toegevoegd op 2-5-05
                Selection.Next(unit:=wdCharacter, Count:=1).Select   'ga naar het teken rechts daarvan:
                If Selection.Characters(1).Case = wdUpperCase Then GoTo 1120  'ZINSGRENS
                'Na openingshaak/apostrophe/Spaanse-?! komt geen hoofdletter:
                ch = Selection.Characters(1).Text   'misschien NOG een openingshaak etc. (max. 3)
                GoTo 1176
             End If
         End If
        GoTo 15  'Andere gevallen van geen spatie na punt betekenen: GEEN zinsgrens.
1120:   'Zinsgrens wordt gevormd door sluithaak(en) na punt (of vraag/uitroepteken):
        iPosSentenceEnd = iPosSentenceEnd + iSluitingsLeesTeken  'kleine correctie op zinseinde-positie
        If MainText Then Set SentenceRange = ActiveDocument.Range(Start:=iPosSentenceStart, End:=iPosSentenceEnd)  '[16-1-09]
        'SentenceRange.SetRange Start:=iPosSentenceStart, End:=iPosSentenceEnd  '[27-12-08]
        nGapNaPuntOfPar = 1  '(de spatie na de haak(en) wordt hier in rekening gebracht)
        GoTo 20  'ZINSGRENS
12:
        'GESPATIEERDE ELLIPSIS (puntjes-op-een-rij MET spaties ertussenin):
        Selection.Next(unit:=wdCharacter, Count:=-1).Select  'wat stond er precies voor tweede punt?
        If Selection.Characters(1).Text <> " " Or _
        nGapNaPuntOfPar <> 1 Then GoTo 1215   'GEEN ellipsis (want niet precies 1 spatie ertussenin);
        Selection.Next(unit:=wdCharacter, Count:=1).Select   'selectie terugzetten op tweede punt
        'kijk [dmv eigengemaakte "movewhile-loop"-op-duo-van-karakters] of er nog meer keren een spatie+puntje volgt:
        nPuntjes = 2
1212:   Selection.Next(unit:=wdCharacter, Count:=1).Select
        Selection.MoveEnd unit:=wdCharacter, Count:=1
        If Selection = " ." Then   'alleen spaties, geen andere tekens zijn toegelaten!
          nPuntjes = nPuntjes + 1
          GoTo 1212
        End If
        Selection.Next(unit:=wdCharacter, Count:=-1).Select
        'het laatste puntje van de reeks wordt nu de nieuwe kandidaat zinseinde-punt:
        iPosSentenceEnd = iPosSentenceEnd + 2 * nPuntjes - 2
        If MainText Then Set SentenceRange = ActiveDocument.Range(Start:=iPosSentenceStart, End:=iPosSentenceEnd)  '[16-1-09]
        'SentenceRange.SetRange Start:=iPosSentenceStart, End:=iPosSentenceEnd  '[27-12-08]
        GoTo 110 'voorlopig beschouwen als ZINSGRENS
1215:   'Kans op legale ellipsis (al dan niet gespatieerd) is nu verkeken:
        Selection.Next(unit:=wdCharacter, Count:=-nGapNaPuntOfPar).Select   'selectie terug naar EERSTE punt (laatste zinseinde-punt);
        'tel nu opnieuw na de punt komende spaties, tabs, linefeeds, manual page breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen maximum aantal!),
        'ook:  ----  ++++  ==== underscore en sterretjes,  maar bovendien: loslopende punten,
        'komma's, dubb.punten en puntkomma's (ook in reeksen), alsmede het sprekerswisselingsteken (lange streep, = ChrW(8212)):   [16-1-09:] ook Chr(2)
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" .,:;" & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212) & Chr(2))  '[16-1-09:]  Chr(2) toegevoegd
        GoTo 20  'ZINSGRENS

'----
        'ONDER LABEL 110 STAAT  ( te r   v e r g e l i j k i n g ) :     [16-1-09]
        'tel na de punt komende spaties, tabs, linefeeds, manual page-breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen maximum aantal!),
        'en bovendien:  ---- , ++++ , ==== , underscore, sterretjes, evt. voetnootnummer [Chr(2)], en sprekerswisselingsteken ChrW(8212):
        'nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212) & Chr(2))
'---


18:
        'Afkortingen en Persoonsnamen:
        '(het gaat hier om afkortingen of voorletters, Voorafgaand aan een Spatie + Hoofdletter)
        If VraagUitroep = True Then GoTo 20   'bij vraag- of uitroepteken: ZINSGRENS
        If nGapNaPuntOfPar > 1 Then GoTo 20   'bij twee of meer spaties: ZINSGRENS;
        'vanaf hier geldt: nGapNaPuntOfPar=1 '[8-1-09]
        'Esperanto afkortingen (die al dan niet aan zinseinde kunnen voorkomen, en die minstens 1 punt-teken bevatten):     '[toegevoegd 6-1-2008]
        Selection.MoveStart unit:=wdCharacter, Count:=-8   'test op afkortingen van max. 5 letters zonder de eindpunt ( "proks." ,  "k.t.p." ):
        'cursor ging 8 posities naar voren, oftewel 2 posities (precies 1 Gap en 1 Punt of vraag/uitroepteken)...
        '...en 6 posities (inclusief voorafgaande spatie) voor het onderscheppen van afkortingen of voorletters
        iPosCheck = Selection.Characters(1).Start
        If iPosCheck = 0 Then 'vlak bij File-begin resteren er mogelijk minder posities [8-1-09]:
            If Len(Selection.Text) < 9 Then  ' 9 omdat voorafgaand aan bovenstaande MoveStart de Selectie precies Lengte=1 had;
                i = 9 - Len(Selection.Text) 'voor een afkorting of voorletters:
                If i = 1 Then GoTo 18001   'resteren er dan maar 5 posities (inclusief voorafgaande spatie)
                If i = 2 Then GoTo 18002   'resteren er dan maar 4 posities (inclusief voorafgaande spatie)
                If i = 3 Then GoTo 18003   'resteren er dan maar 3 posities (inclusief voorafgaande spatie)
                If i = 4 Then GoTo 18004   'resteren er dan maar 2 posities (inclusief voorafgaande spatie)
                If i > 4 Then GoTo 20  'zinsgrens [9-1-09:] soms wordt door ESPSOF aan File-begin GEEN paragraaf-teken toegevoegd)
            End If
        End If
        h = Left(Selection.Text, 6):   If h = " proks" Then GoTo 15  'geen zinseinde-afkorting; het Hoofdletterwoord erna is mogelijk een Eigennaam  ( "proks. Nigran Maron" )
                                                  If h = " k.t.p" Then GoTo 20  'typische zinseinde-afkorting; wschl ZINSEINDE
        Selection.MoveStart unit:=wdCharacter, Count:=1    'test op afkortingen van 4 letters  ( "anst." ,  "inkl." ,  "prof." ,  "trad." , "resp." ,   '[8-1-09:] "ibid." ) :
18001:  h = Left(Selection.Text, 5):   If h = " anst" Or h = " inkl" Or h = " prof" Or h = " Prof" Or h = "Prof." Or h = " ibid" Or h = " Ibid" Or h = "Ibid." Or h = " trad" Or h = " resp" Then GoTo 15
                                                  '(geen zinseinde-afkortingen; het Hoofdletterwoord erna is wschl een Eigennaam:  "prof. Wells", "anst. Bush", "inkl. Kanadon", "trad. Armela" , ...) ;    "Ibid." kan wel zinseinde zijn  '[8-1-09]
        Selection.MoveStart unit:=wdCharacter, Count:=1    'test op afkortingen van 3 letters  ( "cap.", "ekz.", "eld.", "ing.", "ktp.", "par.", "vol.", "k.a.", "k.s.", "a.K.", ... ) :
18002:  h = Left(Selection.Text, 4):   If h = " " & ChrW(265) & "ap" Or h = " ekz" Or h = " eld" Or h = " in" & ChrW(285) Or h = " In" & ChrW(285) Or h = "In" & ChrW(285) & "." Or h = " par" Or h = " red" Or h = " rim" Or h = " vol" Or _
                                                  h = " i.a" Or h = " t.e" Or h = " t.n." Or h = "Prof" Or h = "Ibid" Then GoTo 15   '(geen zinseinde-afkortingen; het Hoofdletterwoord erna is wschl Eigennaam:  "ing. Roget", "eld. UEA", "ekz. Jim" );
                                                  If h = " ktp" Or h = " k.a" Or h = " k.s" Or h = " a.K" Or h = " p.K" Then GoTo 20  'mogelijke zinseinde-afkorting; wschl ZINSEINDE
        Selection.MoveStart unit:=wdCharacter, Count:=1    'test op afkortingen van 2 letters  ( "kp." , "vd." , "p�." , "bv." ;       '[8-1-09:] p� = pa�o):
18003:  h = Left(Selection.Text, 3):   If h = " kp" Or h = " vd" Or h = " p" & ChrW(285) Or h = "In" & ChrW(285) Then GoTo 15  'geen zinseinde-afkorting; een Hoofdletterwoord erna is mogelijk een Eigennaam  ( "kp. Tolstoj", "vd. PIV");
                                                  If h = " bv" Then GoTo 20  'mogelijke zinseinde-afkorting;          'N.B.: voor "Prof." en "Ing." aan zinsBEGIN zijn in de hierbovenstaande regels uitgekookte voorzieningen getroffen!
        Selection.MoveStart unit:=wdCharacter, Count:=1    'test op afkortingen van 1 letter  ( "c." , "k." , "p." ) :
18004:  h = Left(Selection.Text, 2):   If h = " " & ChrW(265) Or h = " k" Or h = " p" Then GoTo 15                        'GoTo 15  =  'GEEN ZINSGRENS
                                                   '(zeker geen zinseinde-afkortingen: �irka�, kaj, pa�o)
        'Persoonsnamen met voorletters en hoofdletters:
        'Test op gevallen als: J. Jansen, G.W. Bush, A.J.M.W. Witkam, Th. Jansen, NIET: TH. Jansen)
        'Selection.MoveStart Unit:=wdCharacter, Count:=-1  '[was eerst: Count=-4; bovenstaande toevoeging 6-1-2008 geeft Count  -8 gevolgd door +4; dus STAAT nu al op -4 ]
          If Selection.Characters(2).Case <> Selection.Characters(1).Case And _
          Letter(Selection.Characters(2).Text) Then  '[*links hiervan staande subconditie vervangt vanaf 26-4-2005 eerdere hier direct onderstaande subcondities:]
            'Asc(Selection.Characters(2).Text) > 64 And Asc(Selection.Characters(2).Text) <> 93 Then   '[*beperkte voor de punt staande sluithaken tot Ascii 93, ...
            'Voor de punt staat een letter (ascii > 64, maar geen 93 [rechte sluithaak])   '[ * ...en ging voorbij aan Unicode 187 en mogelijke andere Unicode sluithaken]
            'die met het teken daarvoor de combinatie 'niet-letter/letter' of 'hoofdletter/kleine-letter' vormt:
            GoTo 15  'GEEN ZINSGRENS
          Else
            GoTo 20  'ZINSGRENS  hier hadden we een geval als:  "...er. Deze..."   of   "...UNO. Deze..."   of   "..."). Deze..."
          End If
    
    
    'VRAAGTEKEN of UITROEPTEKEN:
    ElseIf Selection.Text = "�" Or Selection.Text = "�" Then
        VraagUitroep = True   'de tekens � en � emuleren vraag- en uitroepteken
        'behandeling is grotendeels dezelfde als bij de PUNT, met uitzondering van persoonsnamen en (de details van) ellipsis
        GoTo 110
            
    'DUBBELE PUNT:
    ElseIf Selection.Text = ":" Then
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
        'helemaal geen of precies 1 spatie na dubbele punt betekent GEEN zinsgrens:
        Selection.MoveStart unit:=wdCharacter, Count:=-1
        '--------------23-5-08-----------:
        Selection.MoveStart unit:=wdCharacter, Count:=-2  '[23-5-08] spatie voorafgaand aan leesteken weghalen:
        If Selection.Characters(1) = " " Then Selection.TypeText ": " Else Selection.Collapse direction:=wdCollapseEnd
        Selection.MoveStart unit:=wdCharacter, Count:=-1
        '--------------
        If nGapNaPuntOfPar = 0 Or _
        nGapNaPuntOfPar = 1 And Selection.Characters(1) = " " Then GoTo 15 'GEEN zinsgrens
        'indien er meerdere spaties, TAB(s), een paragraafteken, linefeed etc optreden:
        GoTo 20  'ZINSGRENS
        'na dubbele punt is hoofdletter geen criterium voor zinseinde!

    'PUNT-KOMMA:
    ElseIf Selection.Text = ";" Then
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
        'helemaal geen of precies 1 spatie na punt-komma betekent GEEN zinsgrens:
        Selection.MoveStart unit:=wdCharacter, Count:=-1
        '--------------23-5-08-----------:
        Selection.MoveStart unit:=wdCharacter, Count:=-2  '[23-5-08] spatie voorafgaand aan leesteken weghalen:
        If Selection.Characters(1) = " " Then Selection.TypeText "; " Else Selection.Collapse direction:=wdCollapseEnd
        Selection.MoveStart unit:=wdCharacter, Count:=-1
        '--------------
        If nGapNaPuntOfPar = 0 Or _
        nGapNaPuntOfPar = 1 And Selection.Characters(1) = " " Then GoTo 15 'GEEN zinsgrens
        'indien er meerdere spaties, TAB(s), een paragraafteken, linefeed etc optreden:
        GoTo 20  'ZINSGRENS
        'na punt-komma is hoofdletter geen criterium voor zinseinde!
        

    'VERTICALE STREEPJE:
    ElseIf Selection.Text = "|" Then
        'inspecteer omgeving, en wel 3 characters ervoor en erna:
        Selection.MoveStart unit:=wdCharacter, Count:=-1
        Selection.MoveEnd unit:=wdCharacter, Count:=1
        'het |-teken als zinsgrens mag niet tussen of direct tegen letters aan staan,
        'er moet een spatie of leesteken voor, en een spatie achter staan:
        If Selection.Characters(1).Case <> -1 Then GoTo 15  'GEEN zinsgrens (want letter ervoor);
        If Selection.Characters(3).Text <> " " Then GoTo 15  'GEEN zinsgrens (want geen spatie erna);
        Selection.MoveStart unit:=wdCharacter, Count:=1    'selectie terugzetten op "|"
        Selection.MoveEnd unit:=wdCharacter, Count:=-1
        'tel nu na de "|" komende spaties, tabs, linefeeds, manual page breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen max. aantal!),
        'ook:  ----  ++++  ==== underscore en sterretjes, en bovendien: loslopende punten,
        'komma's, dubb.punten en puntkomma's (ook in reeksen), alsmede het sprekerswisselingsteken (lange streep, = ChrW(8212)):
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" .,:;" & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
        GoTo 20  'ZINSGRENS
        
        
    'PARAGRAPH-TEKEN:
    ElseIf Selection.Text = vbCr Then   'vbCr = Chr(13) = CR = Paragraph-teken
        'kijk of er een hele rits van andere paragraaftekens, spaties, tabs, linefeeds etc achteraan komt:
        'tel na het paragraafteken komende spaties, tabs, linefeeds, manual page breaks, column breaks [ChR(14), PLUS-versie], paragraaftekens (geen maximum aantal!),
        'en ook:  ----  ++++  ==== underscore en sterretjes, en bovendien: punten,
        'komma's, dubb.punten en puntkomma's, zowel loslopend als in reeksen, alsmede het sprekerswisselingsteken (lange streep, = ChrW(8212)):
        nGapNaPuntOfPar = Selection.MoveWhile(Cset:=" .,:;" & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
        'nGapNaPuntOfPar betekent hier: spaties, tabs etc. na (eerste) paragraafteken;
            'controle op evt. LEGE file [19-3-2007]:
            If EersteParagraphTeken And nGapNaPuntOfPar = -1 Then  ' [21-1-09]
                iPosSentenceEnd = Selection.Characters(1).Start  ' [21-1-09]
                If Not ((iPosSentenceEnd - iPosSentenceStart) > 0) Then  ' [21-1-09]
                    GoTo 9876    'lege file, geen tekst  [21-1-09]
                Else
                    nGapNaPuntOfPar = 0  ' [21-1-09]
                    GoTo 714  ' [21-1-09]
                End If
            End If
            EersteParagraphTeken = False  'reset na eerste keer [19-3-2007]
        'kijk of het eerste teken NA die rits een hoofdletter is:
713: Selection.MoveStart unit:=wdCharacter, Count:=-1
        Selection.Next(unit:=wdCharacter, Count:=1).Select  'eerste teken na de spatie(s), of eerste leesteken;
        '[toevoeging 4-2-04:]
        If Selection.Characters(1).Text = Chr(123) Then  '[invoeging PLUS-versie:] openingsaccolade metatekst
            'MsgBox ("openingsaccolade metatekst;  nGapTotHier= " & nGapNaPuntOfPar) '['test PLUS-versie]
            nGapNaPuntOfPar = nGapNaPuntOfPar + Selection.MoveUntil(Cset:=Chr(125)) + 1  'skip alles tot sluitingsaccolade metatekst
            'MsgBox ("sluitingsaccolade metatekst;  nGapTotHier= " & nGapNaPuntOfPar)  '['test PLUS-versie]
            Selection.MoveStart unit:=wdCharacter, Count:=-1
            Selection.Next(unit:=wdCharacter, Count:=1).Select  'sluitingsaccolade metatekst
            nGapNaPuntOfPar = nGapNaPuntOfPar + Selection.MoveWhile(Cset:=" .,:;" & Chr(160) & vbTab & vbLf & Chr(11) & Chr(12) & Chr(14) & vbCr & vbCrLf & "-+=_*" & ChrW(8212))
            'MsgBox ("nGapTotaal= " & nGapNaPuntOfPar)  '['test PLUS-versie]
            GoTo 713
       End If  '[einde invoeging PLUS-versie]
       If Selection.Characters(1).Case <> wdUpperCase Then  '[27-1-09:  "And nGapNaPuntOfPar = 0"  is nu een regel naar beneden verplaatst ]
            If Selection.Characters(1).Text = Chr(91) Then GoTo 20  'bij RECHTE OPENINGSHAAK na Paragraafteken: ZINSGRENS  '[27-1-09]
            If nGapNaPuntOfPar = 0 Then GoTo 15 'GEEN zinsgrens (wschl abusievelijk gebruik Paragraafteken aan regeleinde)
       ElseIf nGapNaPuntOfPar = 1 Then 'bij precies 1 bijzonder teken achter paragraafteken: test of dit...
            Selection.Next(unit:=wdCharacter, Count:=-1).Select  '...een Manual Page Break dan wel Column Break is [PLUS-versie]
            If Selection.Characters(1).Text = Chr(12) Or Selection.Characters(1).Text = Chr(14) Then
                'MsgBox ("Paragraafteken + Manual Page/Column-Break ontdekt")  '[test PLUS-versie]
                GoTo 15  '(GEEN zinsgrens)
            End If
        End If
714:
        'nu cursor terug over nGapNaPuntOfPar:
        Selection.MoveEnd unit:=wdCharacter, Count:=-(nGapNaPuntOfPar + 1)
        nGapVoorPar = -(Selection.MoveWhile(Cset:=" " & Chr(160) & vbTab & vbLf & Chr(11) & vbCr & vbCrLf, _
                          Count:=wdBackward))
        Selection.Next(unit:=wdCharacter, Count:=-1).Select  'eerste (lees-)teken voor de spatie(s);
        ch = Selection.Characters(1).Text
        'PARAGRAAF-teken ZELF dient als ZINSGRENS
        'In dit geval de lengte van de 'gap' aftrekken van de SentenceRange:
        iPosSentenceEnd = iPosSentenceEnd - nGapVoorPar
        If MainText Then SentenceRange.SetRange Start:=iPosSentenceStart, End:=iPosSentenceEnd  '[13-1-09:] "If" toegevoegd
        GoTo 20   'zin ervoor is niet afgesloten, dus Paragraafteken bewerkt ZINSGRENS;
        
    End If

 
15:
'   GEEN ZINSGRENS:
'   Nu vanaf de positie waar hoofd-FIND (stmt 100:) gebleven was verder zoeken
'   naar een van de tekens .?!:;|
'   Het eerstvolgende teken kan alweer een FOUND opleveren:
'   denk aan de sequentie   .P      (punt-Paragraafteken)
'   denk aan de sequentie   .|
'
       'Zet cursor direct achter de positie van laatste FIND:
       If MainText Then
            iPosCheckLaatste = Selection.Characters(1).End   '[5-1-09]
            Selection.Collapse direction:=wdCollapseEnd  '(alleen bij LAATSTE zin werkt CollapseEnd als CollapseStart)
            If Selection.Characters(1).End = iPosCheckLaatste Then  'cursor staat nu precies achter laatste zinspunt (of vraag/uitroepteken)  '[15-1-09]
                'MsgBox "LAATSTE zinsgrens van MainText-Story [5-1-09]"
                LaatsteZinInMainText = True
                Selection.MoveStart unit:=wdCharacter, Count:=-2   '[15-1-09]
15081:      Selection.MoveStart unit:=wdCharacter, Count:=-1   '[15-1-09]
                If Letter(Selection.Characters(1).Text) Or Cijfer(Selection.Characters(1).Text) Then  '[15-1-09]
                    If Selection.Characters(2).Text = Chr(2) Then   '[15-1-09]
                        FootOrEndNoteMark = True   '[15-1-09]
                    End If
                Else
                    GoTo 15081   '[15-1-09]
                End If
                Selection.Collapse direction:=wdCollapseEnd   '[15-1-09]
                GoTo 20  'dit was LAATSTE zin; GoTo ZINSGRENS
            End If
            SentenceRange.Select
            Selection.Collapse direction:=wdCollapseEnd
       ElseIf FootnotesBeingProcessed Then
            iPosCheckLaatste = Selection.Characters(1).End   '[5-1-09]
            Selection.Collapse direction:=wdCollapseEnd  '(alleen bij LAATSTE zin werkt CollapseEnd als CollapseStart)
            If Selection.Characters(1).End = iPosCheckLaatste Then
                'MsgBox "LAATSTE zinsgrens van Footnote-Story"
                LaatsteZinInFootnotes = True
                GoTo 20  'dit was LAATSTE zin in Footnotes; GoTo ZINSGRENS
            End If
        ElseIf EndnotesBeingProcessed Then
            iPosCheckLaatste = Selection.Characters(1).End   '[5-1-09]
            Selection.Collapse direction:=wdCollapseEnd  '(alleen bij LAATSTE zin werkt CollapseEnd als CollapseStart)
            If Selection.Characters(1).End = iPosCheckLaatste Then
                'MsgBox "LAATSTE zinsgrens van Endnote-Story"
                LaatsteZinInEndnotes = True
                GoTo 20  'dit was LAATSTE zin in Endmotes; GoTo ZINSGRENS
            End If
        End If
        
        GoTo 100   'op naar de volgende FIND


20:
'   ZINSGRENS:
    'De EIND-GRENS van een zin is nu bepaald; de hele zin wordt nu geselecteerd door
    'het hieronder staande stmt, en de selectie wordt zichtbaar bij het verschijnen van
    'de eronder staande Msgbox:
    'SentenceRange.Select
    If MainText Then  '[27-12-08]
        SentenceRange.Select
    Else  'If Footnotes or Endnotes:
        Call iPosStartEndSelecteer   '[3-1-09, ipv bovenstaand stmt (Range werkt niet goed bij Footnotes of Endnotes) ]
    End If
    nGapLength = nGapVoorPar + nGapNaPuntOfPar
    '(dit is de lengte van de 'gap'-lengte ACHTER de zin; die ERVOOR heet nPreviousGapLength)
    'If MsgBox("ZINSBEGRENZING afgesloten," & vbCr & _
    "sentenceRange = " & iPosSentenceStart & " - " & iPosSentenceEnd _
    & vbCr & vbCr & "nGapLength = " & nGapLength _
    & vbCr & "verder gaan?", vbYesNo) = vbNo Then GoTo 9876  'STOP het programma
    'in de verdere bewerking van deze zin (waarvan de rechter zinsgrens ontdekt is)
    'is SentenceRange het houvast!
    

'   Check of EINDE-van-FILE soms bereikt is:
    If nGapLength < 0 Or iPosSentenceStart >= iPosSentenceEnd Then
      'EINDE-VAN-TEKSTFILE bereikt!
      GoTo 9876
    End If


'   Check op evt. ALINEAGRENS (of de zojuist geidentificeerde zin de eerste van een alinea is):
'   Regels:   I. Een alinea kan alleen beginnen op een (eerder bepaalde) zinsgrens.
'            II. In de 'gap' die aan de zinsgrens VOORAFgaat moet minstens 1 Paragraafteken [vbCr, Chr(13)] zitten.
'           III. De eerste zin van een document is altijd het begin van een alinea.
'   SentenceRange.Select
    Selection.Collapse direction:=wdCollapseStart
    'Aan conditie I is voldaan (we komen immers van 20, hierboven); conditie II en III:
    If Selection.MoveUntil(Cset:=vbCr, Count:=-nPreviousGapLength) <> 0 Or nAantalAlineas = 0 Then
        nAantalAlineas = nAantalAlineas + 1
        nZinsNummer = 0   'voor telling van zinnen per alinea (zinsnummer AZM-Field);
        'If MsgBox("Nieuwe ALINEA;   doorgaan?", vbYesNo) = vbNo Then GoTo 9876
    End If
    If MainText Then   '[27-12-08]
        SentenceRange.Select   'terugzetten selectie
    Else  'If Footnotes or Endnotes:
        Call iPosStartEndSelecteer   '[3-1-09, ipv bovenstaand stmt (SentenceRange werkt niet goed bij Footnotes of Endnotes) ]
    End If
    
    
    
    
    
    
'BEREKENING VAN DE ZINSLENGTE in AANTAL WOORDEN:
    
'   ComputeStatistics (volgens methode van MS Word zoals via de menus 'Tools' en 'Word-Count'):
    If MainText Then   '[27-12-08]
        nWordsPerSentence = SentenceRange.ComputeStatistics(Statistic:=wdStatisticWords)
        If FootOrEndNoteMark Then nWordsPerSentence = nWordsPerSentence - 1   'betreft de Note-MARK, NIET de Note zelf  [29-1-09]
    Else  'If Footnotes or Endnotes:
        nWordsPerSentence = Selection.Range.ComputeStatistics(Statistic:=wdStatisticWords)
    End If
    
    
    'MsgBox "Statistics Word Count = " & nWordsPerSentence
    
'   Correctie op door ComputeStatistics-woord-telling meegetelde leestekens (dat zijn er
'   slechts enkele gevallen, in tegenstelling tot de vele leestekens die door de standaard
'   VBA-Word-Count-telling ten onrechte zouden worden meegerekend):
    With Selection.Find  'het zoeken van TUSSEN TWEE SPATIES ingebedde leestekens:
        .Text = " [-.,;:?/<>'" & Chr(34) & "][ ]"   'ASCII-teken 34 is: dubbele apostrophe
        'deze bijna onleesbare (maar ivm syntax noodzakelijke) stmt kan gelezen worden als:
        'Text = " [-.,;:?/<>'"][ ]"    dus:   SPATIE-[-.,;:?/<>'"]-SPATIE;
        .Wrap = wdFindStop
        .MatchWildcards = True
    End With
40: Selection.Find.Execute
    If Selection.Find.Found = False Then GoTo 50
    iNonWord = iNonWord + 1   'gevonden leesteken bijtellen
    'selectie nu opschuiven tot resterend (nog niet onderzochte) deel van de zin:
    Selection.Start = Selection.Start + 1
    If MainText Then  '[10-1-09]
        Selection.End = SentenceRange.End  '[26-1-09: na hertesten bevestigd]
    Else  'If Footnotes or Endnotes:  '[10-1-09]
        Selection.End = iPosSentenceEnd
    End If
    GoTo 40   'zoek verder naar leestekens

50: 'Correctie op evt. spatie voor eindpunt of ander eindteken:
    ch = Right(Selection.Text, 2)
    If ch = " ." Or ch = " �" Or ch = " �" Or ch = " :" Or ch = " ;" Or ch = " |" Then
        iNonWord = iNonWord + 1   'correctie meetelling eindteken door Compute-Statistics
    End If
    'Zinseinde bereikt, correctie op ComputeStatistics-woord-telling aanbrengen:
    nWordsPerSentence = nWordsPerSentence - iNonWord
    'MsgBox "Statistics Word Count NA CORRECTIE= " & nWordsPerSentence
    iNonWord = 0   'leestekens-teller terugzetten voor volgende zin
    'Terugzetten selectie naar stand voor correctie:
    If MainText Then   '[27-12-08]
        SentenceRange.Select   'hele zin wordt opnieuw geselecteerd
    Else  'If Footnotes or Endnotes:
        Call iPosStartEndSelecteer  '[26-1-09]
    End If
    'MsgBox "einde Woorden-telling"
    '
    '
    '   AANWIJZINGEN VOOR HEN DIE GEBRUIK MAKEN VAN DEZE WOORDENTELLING:
    '
    '   1. Leestekens of ritsen van leestekens die zonder tussenliggende spaties
    '      tegen een letterwoord aanliggen (ervoor- of erachter-aan) beinvloeden
    '      de woorden-telling NIET.
    '   2. Ook een enkel leesteken -.,;:?/<>'" dat is ingebed tussen twee spaties
    '      beinvloedt de woorden-telling NIET.
    '   3. Een zinseinde-teken (de punt, het vraag- of uitroepteken, de dubbele punt,
    '      de puntkomma, of het verticale streepje), ook al wordt dat voorafgegaan
    '      door een spatie, beinvloedt de woorden-telling NIET.
    '   4. Een rits leestekens die tussen twee spaties is ingebed, wordt ALS 1 WOORD geteld.
    '   5. Een enkel leesteken of een rits leestekens ingebed tussen een spatie
    '      en het zinseinde-teken wordt ALS 1 WOORD geteld.
    '
    '      Ad 1) Dit geldt in het bijzonder voor komma's achter woorden, apostrophen
    '            (enkele of dubbele), hyphens (ook in woordsamenstellingen).
    '
    '      Ad 2) Dit geldt o.a. voor losstaande gedachtenstrepen en voor
    '            gespatieerde ellipsis (puntjes met spaties ertussen).
    '            Het geldt echter NIET voor het teken & (in bijv. Vroom & Dreesman).
    '
    '   Onder de door dit macro getelde woorden van een zin kunnen dus soms (geval 4)
    '   'woorden' voorkomen die geheel bestaan uit leestekens. Gebruikers van dit macro
    '   die zulke woorden niet als woorden beschouwen, zullen dus soms een wat langere
    '   zinslengte voorgeschoteld krijgen dan het aantal 'echte' woorden.
    '   Verder wordt erop gewezen dat een getal of een string van cijfers en leestekens
    '   (bijv. een datum) door het macro ook als 'woord' wordt meegeteld.
    '   Gebruikers die alleen geinteresseerd zijn in 'taalwoorden' dienen dus zelf deze
    '   'niet-taalwoorden' uit te filteren.
    '   Tenslotte: een (dmv een hyphen) SAMENGESTELD WOORD wordt geteld ALS 1 WOORD (niet als 2),
    '   dus bijv. "luchthaven-inspectie" is 1 woord.
    '
    
    'Beveiliging tegen overschrijding maximale zinslengte (250 woorden):
    If nWordsPerSentence > 250 Then
 MsgBox "Frazlongo transiras la permesitan maksimumon (250 vortojn):" & vbCr & _
           "la jhus legita frazo enhavas " & nWordsPerSentence & " vortojn!" & vbCr & vbCr & _
           "Re-aranghu la tekston,  forigu la jam metitajn 'Field'-indikilojn per (en MS Word):" & vbCr & _
           "'Edit' - 'Replace' - 'More' - 'Special' - 'Field' ,   kaj startigu la programon denove.", _
           Title:="EspWSTAT.AFMbazo"
           GoTo 1099
    End If
    
    
                'En hier volgt per zin de berekening van GEMIDDELDE EN VERDELING
                'van de ZINSLENGTEN in de hele tekstfile:
    
    'als bijdrage voor berekening gemiddelde:
    nTotaalAantalZinnen = nTotaalAantalZinnen + 1
    WstatnTotaalAanZinslengten = WstatnTotaalAanZinslengten + nWordsPerSentence
    'voor in kaart brenging verdeling en berekening standaard deviatie e.d.:
    ZinsLengte(nWordsPerSentence) = ZinsLengte(nWordsPerSentence) + 1
    WstatnTotaalAanKwadraten = WstatnTotaalAanKwadraten + nWordsPerSentence * nWordsPerSentence
    '(bij de array-dimensionering is uitgegaan van een max. zinslengte van 250)
    
    
                'Visuele inspectie zinslengte-bepaling per doorlopen zin:
        
    'Activeer onderstaande 2 stmts voor VISUELE CONTROLE op zinslengte-bepaling:
    'Selection.Collapse Direction:=wdCollapseEnd  'visueel prettig tijdens testen
    'If MsgBox(nWordsPerSentence, vbYesNo) = vbNo Then GoTo 9876


                'En hier volgt de AZM-Field creatie,
                'met Fields van het type (36-2.,14) :
      

    If nAantalAlineas = 1 Then  '*toegevoegd 18-5-05
        If Not MsgBox1eAlineaShown Then   '*check op MsgBox1eAlineaShown toegevoegd 11-4-2007
            'If MsgBox("1e alinea in deze file krijgt als AlineaNummer:  1", vbYesNo) = vbNo Then
            'If MsgBox("ESPSOF nun enmetos FrazKomencMarkojn tra la tuta dosiero;" & vbCr & _
                            "per tiuj estos nombritaj ankau la ALINEOJ :" & vbCr & vbCr & _
                            "Chu la 1-a Alineo ricevu la numeron: 1  ?", vbYesNo, "EspWSTAT.AFMbazo") = vbNo Then
            If iNummer1eAlinea <> 1 Then  'ipv bovenstaande MsgBox wordt afgegaan op de Public invoervariabele iNummer1eAlinea...  [3-6-08]
                Getalinvoer = iNummer1eAlinea  ' ...(verkregen via EnigoTEKSTanal [3-6-08])
                GoTo Check1eAlineaNr    '[3-6-08]
                'alleen indien de invoervariabele geen bruikbaar integer getal is, wordt alsnog om invoer gevraagd:
Invoer1eAlineaNr:
                Getalinvoer = InputBox("Entajpu la deziratan numeron de la 1-a Alineo:", "EspWSTAT.AFMbazo")
Check1eAlineaNr:
                If Getalinvoer = "" Then GoTo Invoer1eAlineaNr
                For iGetalinvoer = 1 To Len(Getalinvoer)   'maak de invoer fool-proof
                    If Not Cijfer(Mid(Getalinvoer, iGetalinvoer, 1)) Then GoTo Invoer1eAlineaNr
                Next iGetalinvoer
                iBasis1eAlinea = CInt(Left(Getalinvoer, 5))
                If iBasis1eAlinea < 0 Or iBasis1eAlinea > 30000 Then GoTo Invoer1eAlineaNr
                'MsgBox "1e alinea in deze file krijgt als AlineaNummer:  " & iBasis1eAlinea
                MsgBox "La 1-a Alineo ricevos la numeron:  " & iBasis1eAlinea, Title:="EspWSTAT.AFMbazo"
            Else
                iBasis1eAlinea = 1
            End If
            MsgBox1eAlineaShown = True
            iBasis1eAlinea = iBasis1eAlinea - 1
        End If
    End If
    
    nZinsNummer = nZinsNummer + 1   'telling van zinnen per alinea
    iField = iField + 1
    '   Invoeging FIELD met zinslabel, voortaan genaamd AZMfield (Alinea- en Zins-Markering):
    If (nAantalAlineas = 1 And MainText) Or FirstFieldFootnotes Or FirstFieldEndnotes Then  '(ook rekening houdend met Voetnoetn en Eindnoten)  [29-1-09]:
        'SentenceRange.Select  'bij Eerste Field in MainText, bescherming tegen complicaties als file begint met Nootnummer (gekopieerd uit Foot- of Endnotes naar Maintext):
        If Selection.Characters(1) = ChrW(2) And Selection.Characters(2) = " " Then  'check op Nootnummer [ Chrw(2) ], ook al zijn de Noten gekopieerd naar Maintext
            Selection.MoveStart unit:=wdCharacter, Count:=2  'schuif begin zinsselectie over Nootnummer en spatie heen  '[6-1-09]
            If Selection.Characters(1) = " " Then Selection.MoveStart unit:=wdCharacter, Count:=1  '(voor het geval dat er TWEE spaties tussen Nootnummer en begin zin staan)
        End If
        If FootnotesBeingProcessed Then FirstFieldFootnotes = False 'reset
        If EndnotesBeingProcessed Then FirstFieldEndnotes = False 'reset  '[29-1-09]
    End If
    Selection.Collapse direction:=wdCollapseStart  '[6-1-09]
    Set AzmField = ActiveDocument.Fields.Add(Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:=nAantalAlineas + iBasis1eAlinea & "-" & nZinsNummer & ".," & nWordsPerSentence, PreserveFormatting:=True)
    
    '   Manipulatie om de optisch hinderlijke string " *\ MergeFormat " weg te krijgen:
    If MainText Then   '[27-12-08]
        ActiveDocument.Fields(iField).Code.Select
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Fields(iField).Code.Select  '[3-1-09]
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Fields(iField).Code.Select  '[29-1-09]
    End If
    TeBewerkenFieldCode = Selection.Text
    TeBewerkenFieldCode = Trim(TeBewerkenFieldCode)
    If Right(TeBewerkenFieldCode, 15) = RTrim(WegTeHalenString) Then  '15 = WegTeHalenString-lengte
        Selection.Font.Italic = 0           'niet cursief
        Selection.Font.Name = "Arial"       'kies ander font (Arial)
        Selection.Font.Size = 9             'kies font size 9
        Selection.Collapse                  'voor deleten van de eerste spatie van het Field is...
        Selection.Delete                    '...een Selection.Expand niet nodig en zelfs schadelijk;
        Selection.MoveStartUntil (" ")      'ga naar tweede spatie
        Selection.MoveEnd unit:=wdCharacter, Count:=16
        Selection.Delete                    'delete de string " \* MERGEFORMAT "
        Selection.Expand unit:=wdCharacter  'ook geheimzinnige laatste spatie deleten
        Selection.Delete
        Selection.MoveStartUntil Cset:=",", Count:=wdBackward
        Selection.Font.Italic = 1            'kies cursief
        Selection.Font.Size = 8              'en kleinste font size 8 voor Zinslengte
        'Ongeacht of het Field al dan niet hidden is, moet alle in dit macro verder te gebruiken
        'char.pos. (start + end) met lengte van het ingevoegde Field gecorrigeerd worden:
        nFieldLength = Len(TeBewerkenFieldCode) - 13   '13 = 2(Field-haken) - 15(WegTeHalenString)
    End If


'***********************************************************
'    De volgende stmts moeten helemaal onderin de "lus",
'    als een zin helemaal is afgewerkt:
'***********************************************************
    '
    'POSITIONERING van cursor etc., alvast voor BEHANDELING VAN DE VOLGENDE ZIN:
    If MainText Then   '[27-12-08]
        SentenceRange.Select  'herstel van de Selectie van de zojuist behandelde zin
    Else  'If Footnotes or Endnotes:
        'iPosSentenceStart = iPosSentenceStart + nFieldLength  '(de Fieldlengte incl. de 2 Field-haken)
        'iPosSentenceEnd = iPosSentenceEnd + nFieldLength  '(de Fieldlengte incl. de 2 Field-haken)
        Selection.Collapse direction:=wdCollapseEnd  'Selection stond op Zinslengte-aanduiding in Field, ...
        Selection.MoveStart unit:=wdCharacter, Count:=1  '...en wordt nu direct achter het Field, dus voor de Zin zelf, gezet   '[4-1-09];
        Selection.MoveEnd unit:=wdCharacter, Count:=nPosSentenceStartEnd  'hiermee wordt de hele Zin teruggeselecteerd   '[4-1-09]
    End If
    Selection.Collapse direction:=wdCollapseEnd
    If LaatsteZinInMainText Then GoTo 9876  '[5-1-09]  (alleen bij MainText-Story)
    If FootnotesBeingProcessed And LaatsteZinInFootnotes Then GoTo 9876  '[5-1-09]
    If EndnotesBeingProcessed And LaatsteZinInEndnotes Then GoTo 9876  '[29-1-09]
    Selection.MoveStart unit:=wdCharacter, Count:=nGapLength
    '(cursor wordt precies voor begin volgende zin gezet)
    'MsgBox "POSITIONERING van cursor voor VOLGENDE ZIN"
    If MainText Then   '[27-12-08]
        iPosSentenceStart = iPosSentenceEnd + nGapLength + nFieldLength
    Else  'If Footnotes or Endnotes:
        iPosSentenceStart = Selection.Characters(1).Start   '[4-1-09]
    End If
    nGapVoorPar = 0   'reset voor volgende ronde
    nGapNaPuntOfPar = 0      'reset voor volgende ronde
    
    'Opsporen van 1-zins-alinea's ivm kunnen herkennen van KOPPEN en TUSSENKOPPEN  [21-4-08]:
    If MainText Then '[5-1-09]
        If nAantalAlineas > nPreviousAantalAlineas And nPreviousAantalAlineas > nPrePreviousAantalAlineas Then
            iKopOfTussenkop = iKopOfTussenkop + 1
            'lengte (in aantal woorden) van het VOORAFGAANDE TEKSTBLOK, vanaf de vorige KOP of TUSSENKOP:
            nLengteBlokVoorKop = WstatnTotaalAanZinslengten - nWordsPerSentence - nPreviousWordsPerSentence - nPreviousTotaalZinslengten
            With WstatWordtoExcel.worksheets(5)
                .Cells(i1 + iKopOfTussenkop, 16).Value = iBasis1eAlinea + nAantalAlineas - 1 'nummer van 1-zins-alinea (KOP of TUSSENKOP)
                .Cells(i1 + iKopOfTussenkop, 17).Value = nPrePreviousGapLength                  'gaplength VOOR die alinea
                .Cells(i1 + iKopOfTussenkop, 18).Value = nPreviousGapLength                       'gaplength ACHTER die alinea
                .Cells(i1 + iKopOfTussenkop, 19).Value = nPreviousWordsPerSentence           'lengte (in aantal woorden) van KOP of TUSSENKOP
                .Cells(i1 + iKopOfTussenkop, 20).Value = nLengteBlokVoorKop                       'lengte (in aantal woorden) voorafgaaand TEKSTBLOK
            End With
            nPreviousTotaalZinslengten = WstatnTotaalAanZinslengten - nWordsPerSentence
        End If
    End If
    nPrePreviousGapLength = nPreviousGapLength
    nPrePreviousAantalAlineas = nPreviousAantalAlineas
    nPreviousAantalAlineas = nAantalAlineas
    nPreviousWordsPerSentence = nWordsPerSentence
    '[einde toevoeging  21-4-08]
    
    nPreviousGapLength = nGapLength
    GoTo 100   'op naar de volgende FIND
    
    
'******************************************
9876:

                'Einde van tekstfile bereikt:

'Check of file uberhaupt tekst bevatte [19-3-2007]:
If nTotaalAantalZinnen = 0 Then MsgBox ("Tekstdosiero sen teksto !,  EspWSTAT.AFMbazo"): GoTo 1015  '[19-3-2007]
If nTotaalAantalZinnen = 1 Then GoTo 1015   '[10-3-2008]

'lengte van TEKSTBLOK na laatste KOP of TUSSENKOP  [21-4-08]:
nLengteBlokVoorKop = WstatnTotaalAanZinslengten - nPreviousTotaalZinslengten
WstatWordtoExcel.worksheets(5).Cells(i1 + iKopOfTussenkop + 1, 20).Value = nLengteBlokVoorKop  'lengte (in aantal woorden)

'Eind-Berekening van gemiddelde zinslengte en uitprinten van individuele zinslengten:
GemiddeldeZinslengte = WstatnTotaalAanZinslengten / nTotaalAantalZinnen
GemiddeldeZinslengte = (Int((10 * GemiddeldeZinslengte) + 0.5)) / 10     ' r met 1 decimaal achter de komma krijg je met:  r = (INT((10*r)+0.5))/10

If Not CalledByTekstAnal Then
StandaardDeviatie = Sqr((WstatnTotaalAanKwadraten _
- (nTotaalAantalZinnen * GemiddeldeZinslengte * GemiddeldeZinslengte)) / (nTotaalAantalZinnen - 1))
StandaardDeviatie = (Int((10 * StandaardDeviatie) + 0.5)) / 10     ' r met 1 decimaal achter de komma krijg je met:  r = (INT((10*r)+0.5))/10

'Vaststellen van de kortste en langste zinslengte:
           For i = 1 To 250  'toevoeging 15-8-05
           If ZinsLengte(i) <> 0 Then GoTo 9878
           Next i
9878:  Imin = i           'Imin is de kortste zinslengte die voorkomt
           For i = 250 To 1 Step -1
           If ZinsLengte(i) <> 0 Then GoTo 9877
           Next i
9877:  Imax = i           'Imax is de langste zinslengte die voorkomt

MsgBox ("nombro da frazoj = " & nTotaalAantalZinnen & vbCr & _
              "meza frazlongo   = " & GemiddeldeZinslengte & vbCr & _
              "varianca devio    = " & StandaardDeviatie & vbCr & _
              "minimuma frazlongo   = " & Imin & vbCr & _
              "maksimuma frazlongo = " & Imax & vbCr & vbCr & _
              "nombro da alineoj = " & nAantalAlineas), _
    Title:="EspWSTAT.AFMbazo"
End If

'Controle-Berekening van gemiddelde zinslengte:
For i = 1 To 250
nControleTotaalAantalZinnen = nControleTotaalAantalZinnen + ZinsLengte(i)
nControleTotaalAanZinslengten = nControleTotaalAanZinslengten + i * ZinsLengte(i)
Next i
If (nControleTotaalAantalZinnen <> nTotaalAantalZinnen) Or (nControleTotaalAanZinslengten <> WstatnTotaalAanZinslengten) Then
GemiddeldeZinslengte = nControleTotaalAanZinslengten / nControleTotaalAantalZinnen   'herberekening, en melden aan gebruiker:
MsgBox "kontrol-nombro da frazoj = " & nControleTotaalAantalZinnen & vbCr & _
              "kontrol-meza frazlongo = " & GemiddeldeZinslengte, _
   Title:="EspWSTAT.AFMbazo"
End If
'einde berekening zinslengte e.d.


                    
                'Terugzetten weggehaalde vraag/uitroep-tekens:
1015:
'
'   Terugzetten van eerder vervangen vraagtekens in de hele file
'   (Alle vraagtekens in de file zijn aan het begin van dit macro tijdelijk
'   vervangen door Pound-Sterling tekens):
'   Beginpositie cursor (zet cursor weer aan begin file):
    'Selection.Collapse
    'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endnotes-deel geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If
    
    Selection.Find.ClearFormatting     'reset eventuele eerdere instellingen van Find
    iVraag = 0
    For i = 1 To 5000 'aanname: geen tekstfile heeft meer dan 5000 vraagtekens
    With Selection.Find
        .Text = "�"    'Pound-Sterling teken, ASCII-code 163 (Latin-1, Basis-Latin)
        .Replacement.Text = "?"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = False
        .Execute Replace:=wdReplaceOne
    End With
    If Selection.Find.Found = False Then GoTo 1018   'laatste vraagteken is teruggezet
    iVraag = iVraag + 1
    Selection.MoveRight unit:=wdCharacter, Count:=1  '(ANDERS VINDT' IE ALLEEN MAAR DIE ENE!!)
    Next i
'   (einde van terugzetten vraagtekens)
1018:
'
'   Terugzetten van eerder vervangen uitroeptekens in de hele file
'   (Alle uitroeptekens in de file zijn aan het begin van dit macro tijdelijk
'   vervangen door dollarcent-tekens):
'   Beginpositie cursor (zet cursor weer aan begin file):
    'Cursor zetten op beginpositie MainText (cq. Footnote texts, Endnote texts):  '[27-12-08]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel  geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endnotes-deel  geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If
    
    Selection.Find.ClearFormatting     'reset eventuele eerdere instellingen van Find
    iRoep = 0
    For i = 1 To 5000 'aanname: geen tekstfile heeft meer dan 5000 uitroeptekens
    With Selection.Find
        .Text = "�"    'dollarcent-teken, ASCII-code 162 (Latin-1, Basis-Latin)
        .Replacement.Text = "!"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = False
        .Execute Replace:=wdReplaceOne
    End With
    If Selection.Find.Found = False Then GoTo 1019   'laatste uitroepteken is teruggezet
    iRoep = iRoep + 1
    Selection.MoveRight unit:=wdCharacter, Count:=1  '(ANDERS VINDT' IE ALLEEN MAAR DIE ENE!!)
    Next i
'   (einde van terugzetten uitroeptekens)
1019:
    'MsgBox "Einde AZM-Plus" & vbCr & vbCr & _
                  iVraag & " vraagtekens teruggezet" & vbCr & _
                  iRoep & " uitroeptekens teruggezet"

1099:

    '[het weer onzichtbaar maken van alle geplaatste [23-9-2007] of reeds aanwezige [23-2-2008] Field-codes ...
    ' ... dmv   'ActiveDocument.ActiveWindow.View.ShowFieldCodes = False'  is ...
    ' ... gedeactiveerd ivm het opgeroepen worden van AlineaEnZinsMarkeerder door EspTextAnalyzer en daarin ahw "ingebed" zijn] '[27-2-2008]

'   Cursor terugzetten op beginpositie file:    [23-9-2007]
    If MainText Then
        ActiveDocument.StoryRanges(wdMainTextStory).Select  'hierdoor wordt het Gewone Tekstgedeelte geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf FootnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdFootnotesStory).Select  'hierdoor wordt het Footnotes-deel  geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    ElseIf EndnotesBeingProcessed Then
        ActiveDocument.StoryRanges(wdEndnotesStory).Select  'hierdoor wordt het Endnotes-deel  geselecteerd
        Selection.Collapse direction:=wdCollapseStart
    End If

End Sub
Sub iPosStartEndSelecteer()

'28-1-2009 TW
'maakt samen met AFMbazo gebruik van de PRIVATE variabelen iPosSentenceStart, iPosSentenceEnd en nPosSentenceStartEnd
Dim iPosNow As Long

Selection.Collapse direction:=wdCollapseEnd
iPosNow = Selection.Characters(1).Start

Selection.MoveStart unit:=wdCharacter, Count:=iPosSentenceStart - iPosNow   '(als PRIVATE variabelen zijn  iPosSentenceStartEnd ...
If iPosSentenceStart > iPosNow Then iPosNow = iPosSentenceStart
Selection.MoveEnd unit:=wdCharacter, Count:=iPosSentenceEnd - iPosNow     ' ...en iPosSentenceEnd hier a.h.w. invoerparameters)
'werkt ook wanneer  Count:=0

nPosSentenceStartEnd = iPosSentenceEnd - iPosSentenceStart   '(als PRIVATE variabele is nPosSentenceStartEnd hier a.h.w. uitvoerparameter)

End Sub

Sub KVEK()     'Versio 1.0   27 Augusto 2005 TW (Toon Witkam)
'KVEK = Konatigi Vortojn en Kunteksto
'(kp. 'KWIC' = Key Word In Context)
'[antaua nederlandlingva nomo:  'AZMenConcordantieEsp' ]


'   La makroo KVEK ebligas fari statistikon de vort-uzo (t.n. "konkordancon") en iu MS Word -tekstdosiero.
'   Antau ol apliki tiun cxi makroon, la tekstdosiero unue devas esti pritraktika per la makroo 'AFMbazo'
'   (vidu supre).

'   Post alvoko (en MS Word, pere de 'Tools' - 'Macro' - 'Macros'... ) de la makroo KVEK,
'   la uzanto povas specifi la VORTON au vort-PARTON pri kiu li/shi deziras statistikon.

'   Post trasercxo de la tekstdosiero, la makroo produktos konkordancon en Folio 2 de la MS Excel -dosiero
'   C:\ESPSOF\ESPSOF-KVEK.xls (la uzanto mem devas antaue malfermi tiun dosieron).

'   La konkordanco montros cxiujn kuntekstojn, en kiuj la specifita VORTO au vort-PARTO aperas.
'   Kaj por la dekstra kaj por la maldekstra flanko, la longecoj (nombroj da vortoj) de la montrotaj kuntekstoj
'   estas specifieblaj, same kiel kelkaj aliaj detaloj. Krom la montrota kunteksto, estos ankau referenco al la
'   aline- kaj fraz-numero de la font-dosiero.

'   La konkordanc-VORTO mem povas esti Substantivo, Adjektivo, Verbo, Adverbo,  au iu ajn alia vorto:
'   ankau funkcivorto eblas.
'   Se la uzanto specifas ekz. 'vundo' kiel konkordanc-vorto, la konkordanco enhavos NUR la aperojn de tiu
'   laulitera vortformo. Tamen, per specifi 'vund-' (notu la dividstreketon), ankau la formoj 'vundoj', 'vundon', 'vundojn',
'   kaj eblaj adjektivaj au (ad)verbaj formoj aperos en la konkordanco.
'   Aldono de ankau participaj finajhkompleksoj (ekz. 'vundinte', 'vunditojn', ...)  estas aparte specifiebla.

'   Se la uzanto elektas la eblecon 'vort-PARTO', ankau cxiuj pli longaj vortoj entenantaj la PARTON aperos
'   en la konkordanco (ATENTU: tiuj povas esti vortoj kun tute alia senco!). Se samtempe la uzanto elektas
'   vort-PARTON kies specifo estas ekz. 'vund-o', ne nur kunmeto 'vundopritraktado' sed ankau 'vund-pritraktado'
'   kaj 'vundpritraktado' aperos en la konkordanco. Formo kun streketo, kiel 'vund-pritraktado', aperos ecx se la
'   la elekto estis 'VORTO'.

'   La makroo KVEK estas speciale tauga por Esperanto. Sed kondicxe ke oni uzas nek la eblecon 'vort-PARTO',
'   nek la dividstreketon, ghi funkcias ankau por aliaj lingvoj (se ties literoj estas en la Unikodo-subaroj 'Basic Latin',
'   'Latin-1', au 'Latin Extended-A'). Krome, ghi funkcias por propraj nomoj kaj akronimoj (specifendaj per majuskloj,
'   kiujn KVEK bone distingas). Ecx konkordanco de entekstaj ciferoj eblas.

    
    Dim WstatLijstConcordWord(1500, 4) As String        'Listig-kapacito = 1500 konkordancoj (por UNUFOJA vortspecifo!).
                                                       'Listigo (poste en Excel-folio) per 4 kolumnoj:
                                                       'kolumno 1: Fonto-kodo (Dosier-nomo, Alineo- kaj Fraz-numero)
                                                       'kolumno 2: maldekstra mikrokunteksto
                                                       'kolumno 3: la specifita konkordanc-vorto mem
                                                       'kolumno 4: dekstra mikrokunteksto
    Dim WstatWordtoExcel As Object
                                                           
    Dim Lengte As Integer
    Dim iZin As Integer
    Dim jTekstWoord As Integer
    Dim iLijstConcordWord As Integer
    Dim WstatnConcordWord As Integer
    Dim nFields As Integer
    Dim TekstWoord As String
    Dim ChBegin As String
    Dim ChEnd As String
        
    Dim textfield As String
    Dim textZinslengte As String
    Dim textAlineaZinsnummer As String
    Dim nZinsLengte As Integer    'wordt in AZM-macro "nWordsPerSentence" genoemd;
    Dim WstatnAantalZinnen As Integer
    Dim WstatnTotaalAanZinslengten As Long
    
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim m As Integer
 
    Dim VooraanGestript As Boolean
    Dim AchteraanGestript As Boolean
    Dim MicroContext As String
    Dim NactuallyMovedLeft As Integer
    
    Dim nmaxMicroContextLeft As Integer     'lengte in characters
    Dim nmaxMicroContextRight As Integer
    Dim InStrNmaxRechts As Integer
    Dim InStrNmaxRechtsNul As Boolean
    
    Dim ConCordWord As String   'het centrale (gegeven) concordantie-woord
    Dim LenConCord As Integer
    Dim IbeginConCordWord As Integer
    Dim IendConCordWord As Integer
    Dim ZinsBuffer As String    'opslag van een hele zin (voor evt extractie microcontext)
    Dim nCharZinsLengte As Integer
    Dim IbeginNoPreviousMatch As Integer
    Dim LinkerKantZin As String
    Dim LenLinkerKant As Integer
    Dim RechterKantZin As String
    Dim LenRechterKant As Integer
    Dim nchar As Long
    Dim ConCordWordmetHoofdLetter As Boolean
    Dim DubbeleApostrofvoorWoord As Boolean
    Dim DubbeleUnderQuotevoorWoord As Boolean
    Dim ApostrofPos As Integer
    
    Static InputWord As String
    Static AnkauKielVortParto As Boolean
    Static Prefikso As Boolean
    Static microcontextlengtelinks As Integer
    Static microcontextlengterechts As Integer
    Static extra36 As Boolean
    Static BronCode As String
    Static PreviousBroncode As String
    Static PreviousWstatnTotaalAanZinslengten As Long
    Static UzFontkolom As Integer
    Static OffSet As Integer
    Static BrontekstFilenaam As String  '[11-3-2008]
    Dim PreviousOffset As Integer
    Dim UserChangedOffset As Boolean
    Dim SekvaRondo As Integer
    Dim AlsnogNieuweBronCode As String
    Dim BronCodeAlsnogVernieuwd As Boolean
    Dim OptionalHyphen As Boolean  '[4-9-08]

    Dim LenInputWord As Integer
    Dim Modo As String
    Dim AnkauKielVortPartoJaNee As String
    Dim extra36JaNee As String
    Dim Hpos As Integer
    Dim Stem As String
    Dim VortParto As Boolean
    Dim Sufikso As Boolean
    Dim NounFlect As Boolean
    Dim AdjFlect As Boolean
    Dim AdvFlect As Boolean
    Dim VerbFlect As Boolean
    Dim Clean As Boolean
    Dim AllCatEndings As Boolean
    Dim EndingFirst As Integer
    Dim EndingLast As Integer
    
    Dim FlectEnding(74) As String
    '1-Dimensionale FlectEndings-array,
    'met per categorie eerst de truncated vorm (STAM) gevolgd door de hoofdvorm:
    FlectEnding(1) = ""
    FlectEnding(2) = "o"            'Noun:  1-5     (hoofdvorm en 3 verbuigingen)
    FlectEnding(3) = "on"
    FlectEnding(4) = "oj"
    FlectEnding(5) = "ojn"
    FlectEnding(6) = ""
    FlectEnding(7) = "a"            'Adj:   6-10     (hoofdvorm en 3 verbuigingen)
    FlectEnding(8) = "an"
    FlectEnding(9) = "aj"
    FlectEnding(10) = "ajn"
    FlectEnding(11) = ""
    FlectEnding(12) = "e"           'Adv:   11-13     (hoofdvorm en 1 verbuiging)
    FlectEnding(13) = "en"
    FlectEnding(14) = ""
    FlectEnding(15) = "i"           'Verb:  14-20 en 21-38
    FlectEnding(16) = "as"          '(hoofdvorm en 5 basis-vervoegingen)
    FlectEnding(17) = "is"
    FlectEnding(18) = "os"
    FlectEnding(19) = "us"
    FlectEnding(20) = "u"
    FlectEnding(21) = "anta"        '(18 participiale vormen)
    FlectEnding(22) = "antaj"
    FlectEnding(23) = "ante"
    FlectEnding(24) = "inta"
    FlectEnding(25) = "intaj"
    FlectEnding(26) = "inte"
    FlectEnding(27) = "onta"
    FlectEnding(28) = "ontaj"
    FlectEnding(29) = "onte"
    FlectEnding(30) = "ata"
    FlectEnding(31) = "ataj"
    FlectEnding(32) = "ate"
    FlectEnding(33) = "ita"
    FlectEnding(34) = "itaj"
    FlectEnding(35) = "ite"
    FlectEnding(36) = "ota"
    FlectEnding(37) = "otaj"
    FlectEnding(38) = "ote"
    
    'de 36 extra  participiale vormen:
    
    FlectEnding(39) = "antan"       '(12 participiale accusatiefvormen op -an -ajn)
    FlectEnding(40) = "antajn"
    FlectEnding(41) = "intan"
    FlectEnding(42) = "intajn"
    FlectEnding(43) = "ontan"
    FlectEnding(44) = "ontajn"
    FlectEnding(45) = "atan"
    FlectEnding(46) = "atajn"
    FlectEnding(47) = "itan"
    FlectEnding(48) = "itajn"
    FlectEnding(49) = "otan"
    FlectEnding(50) = "otajn"
    FlectEnding(51) = "anto"        '(24 participiale verzelfstandigingen op -o -on -oj -ojn)
    FlectEnding(52) = "antoj"
    FlectEnding(53) = "into"
    FlectEnding(54) = "intoj"
    FlectEnding(55) = "onto"
    FlectEnding(56) = "ontoj"
    FlectEnding(57) = "ato"
    FlectEnding(58) = "atoj"
    FlectEnding(69) = "ito"
    FlectEnding(60) = "itoj"
    FlectEnding(61) = "oto"
    FlectEnding(62) = "otoj"
    FlectEnding(63) = "anton"
    FlectEnding(64) = "antojn"
    FlectEnding(65) = "inton"
    FlectEnding(66) = "intojn"
    FlectEnding(67) = "onton"
    FlectEnding(68) = "ontojn"
    FlectEnding(69) = "aton"
    FlectEnding(70) = "atojn"
    FlectEnding(71) = "iton"
    FlectEnding(72) = "itojn"
    FlectEnding(73) = "oton"
    FlectEnding(74) = "otojn"
        

    ConCordWordmetHoofdLetter = False
       
'   Het altijd zichtbaar maken van FieldCodes (indien dit niet reeds door de gebruiker in MS Word via het Tools-Options menu gedaan is)
'   is essentieel voor de goede werking van het macro:
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True    '[ **toegevoegd 14-10-2004 ]


'   Telling van het precieze aantal in de file aanwezige Fields:
    nFields = ActiveDocument.Fields.Count
    If (nFields > 0) Then
        If Not ActiveDocument.Name = BrontekstFilenaam Then  'vermijdt herhaling bericht bij gelijkblijvende source-tekst:
            If MsgBox("Estas " & nFields & " ghuste markitaj frazoj ('Fields') en tiu cxi fonttekst-dosiero." & vbCr & vbCr & _
                    "Certigu ke jena Excel-dosiero estas malfermita:" & vbCr & _
                    "C:\ESPSOF\ESPSOF-KVEK.xls", _
                    vbOKCancel, "KVEK   -   makroo por konkordanc-listigo") = vbCancel Then GoTo 999
        End If
    Else
      MsgBox "Mankas 'Fields' (FrazKomencMarkoj) en tiu cxi dosiero!" & vbCr & vbCr & _
                    "La dosiero nepre estas pritraktenda per la makroo 'AFMbazo'" & vbCr & _
                    "antau ol apliki la makroon 'KVEK'.", _
                    Title:="KVEK   -   makroo por konkordanc-listigo"
      GoTo 999
    End If
    
'-------------startwaarden (Static Varibles!):-----------
'(worden slechts eenmalig geeffectueerd, aan het BEGIN VAN EEN SESSIE):
If InputWord = "" Then InputWord = "akrobato"  'suggestief voorbeeld
If microcontextlengtelinks = 0 Then microcontextlengtelinks = 10   'aangeraden waarde
If microcontextlengterechts = 0 Then microcontextlengterechts = 10 'aangeraden waarde
If BronCode = "" Then BronCode = "MiaLibro"  'suggestief voorbeeld
If OffSet = 0 Then OffSet = 2
If UzFontkolom = 0 Then UzFontkolom = 7

'-----------------------invoerblok:----------------------------
'(wordt geeffectueerd bij elke nieuw gebruik van dit programma
' tijdens DEZELFDE sessie):

10: 'Reset flags:
    NounFlect = False
    AdjFlect = False
    AdvFlect = False
    VerbFlect = False
    Clean = False
    AllCatEndings = False
    PreviousBroncode = BronCode
    
'-----------------Invoer-Dialoog: -----------------------

'Vraag gebruiker het Concordantie-woord in te voeren,
'middels speciaal daarvoor gemaakte UserForm:
Load EnigoKVEK
With EnigoKVEK

    'meest recente waarden:
    .InputWordBox.Text = InputWord
    .AnkauKielVortPartoCheckBox.Value = AnkauKielVortParto
    If Prefikso Then .AnkauKielVortPartoCheckBox.Value = False
    .NurAntauaPartoCheckBox.Value = Prefikso
    .LeftMicroContextBox.Value = microcontextlengtelinks
    .RightMicroContextBox.Value = microcontextlengterechts
    .Extra36ParticFormsCheckBox.Value = extra36
    .BronCodeBox.Value = BronCode
    
    .Show

    InputWord = .InputWordBox.Text
    Prefikso = .NurAntauaPartoCheckBox.Value
    AnkauKielVortParto = .AnkauKielVortPartoCheckBox.Value
    
    If AnkauKielVortParto Then
                    VortParto = True
                    If Not Prefikso Then
                        Modo = "ANKAU KIEL VORTPARTO"
                    End If
                    If Prefikso Then Modo = "NUR KIEL ANTAUA VORTPARTO"
        Else
                    VortParto = False
                    If Not Prefikso Then
                        Modo = "KIEL VORTO"
                    End If
                    If Prefikso Then
                        VortParto = True
                        Modo = "NUR KIEL ANTAUA VORTPARTO"
                    End If
    End If
    'De keuze voor NUR ANTAUA is onafhankelijk van het aanstippen van ANKAU VORTPARTO, en...
    'overrule't die in feite. Bij NUR ANTAUA worden namelijk geen (en bij ANKAUA wel) volledige woordmatches ...
    'als concordantie beschouwd. Het verschil tussen beide opties zit 'm dus vooral in de tegenstelling NUR - ANKAU.
    '[Iets anders is dat om programmatechnische reden de Boolean 'VortParto' ook bij NUR ANTAUA gezet blijft.]
    
    microcontextlengtelinks = .LeftMicroContextBox.Value
    microcontextlengterechts = .RightMicroContextBox.Value
    extra36 = .Extra36ParticFormsCheckBox.Value
    If extra36 Then extra36JaNee = "JES" Else extra36JaNee = "ne"
    BronCode = Left(.BronCodeBox.Value, 8)    'max. 8 tekens
        
End With
'deze dialoog is zgn. "modaal", en wordt afgesloten
'zodra de gebruiker het kruisje in rechterbovenhoek aanklikt
'(een OK-button en een Cancel-button zijn niet nodig)
Unload EnigoKVEK


    Sufikso = False  '[**afgeklemde overbodige modus (10-4-03)]

'------------------einde invoer-dialoog--------------

    'Omrekening door gebruiker gewenste microcontextlengtes in aantallen tekens:
    nmaxMicroContextLeft = microcontextlengtelinks * 6 + 3
    nmaxMicroContextRight = microcontextlengterechts * 6 - 3
    'factor 6 is het gemiddelde aantal tekens (incl. spatie) per woord;
    '3 (halve gemiddelde woordlengte) is de tolerantie ivm afbreking TUSSEN woorden ipv middenin woorden
     
    LenInputWord = Len(InputWord)
    Hpos = InStr(3, InputWord, "-")  'positie van evt. hyphen in de inputstring
    If Hpos = 0 Then GoTo 11                 'geen hyphen
    If Hpos = LenInputWord - 1 Then GoTo 12  'hyphen is op-1-na laatste teken
    If Hpos = LenInputWord Then GoTo 13      'hyphen is laatste teken
    If InStr(1, InputWord, "-") > 0 Then
        MsgBox "Se vi uzas streketon, ghi estu la lasta au antaulasta signo," & Chr(13) & _
                      "ekzemple:    decid-    decid-o    decid-a    decid-e    decid-i", _
          Title:="KVEK   -   makroo por konkordanc-listigo"
        GoTo 10 'nieuwe invoer
    End If
    
11  'Woord is 'clean' (zonder hyphen):
    ConCordWord = InputWord
    Clean = True
    GoTo 15
    
12  'Woord met hyphen gevolgd door 1 ander teken:
    ChEnd = Right(InputWord, 1)
    Select Case ChEnd
        Case "o"
                    NounFlect = True
        Case "a"
                    AdjFlect = True
        Case "e"
                    AdvFlect = True
        Case "i"
                    VerbFlect = True
        Case Else
        MsgBox "Post la streketo, nur unulitera kategoria finajho" & Chr(13) & _
                        "estas permesita, do nur:     -o     -a     -e     -i ", _
            Title:="KVEK   -   makroo por konkordanc-listigo"
        GoTo 10 'nieuwe invoer
    End Select
    Stem = Left(InputWord, LenInputWord - 2)  'woordstam = inputword tot aan de hyphen
    ConCordWord = Stem
    GoTo 15
    
13  'Woord met hyphen als laatste teken:
    NounFlect = True
    AdjFlect = True
    AdvFlect = True
    VerbFlect = True
    AllCatEndings = True
    Stem = Left(InputWord, LenInputWord - 1)  'woordstam = inputword tot aan de hyphen
    ConCordWord = Stem
    GoTo 15
       
15:
    LenConCord = Len(ConCordWord)          'niet overbodig
    If Hoofdletter(Left(ConCordWord, 1)) Then ConCordWordmetHoofdLetter = True
    
    

'Ga de Fields van alle zinnen langs:

100: 'GROTE BUITENLUS (VOOR ALLE ZINNEN IN DE TEKST-FILE):
    For iZin = 1 To nFields     'met elk Field correspondeert precies 1 zin
        ActiveDocument.Fields(iZin).Select
        textfield = ActiveDocument.Fields(iZin).Code.Text
        
        'Sla de hele zin alvast als string op voor evt latere extractie van microcontext:
        Selection.Collapse direction:=wdCollapseEnd   'cursor nu op Beginpunt van de geselecteerde zin (direct achter het daarbij behorende Field)
        'Eindpunt van de te selecteren zin is het begin van het Field van de volgende zin:
        nchar = Selection.MoveEndUntil(Chr(19))   'ASCII 19 (DC3) is de speciale beginhaak van een Field (en is NIET de gewone accolade!)
        If nchar = 0 Then Selection.MoveEnd unit:=wdParagraph   'alleen bij LAATSTE ZIN   van document: Paragraafteken dient als zinseinde
        ZinsBuffer = Selection.Text
        ZinsBuffer = HaalOptionalHyphensWegUitWoord(ZinsBuffer, OptionalHyphen)
        nCharZinsLengte = Len(ZinsBuffer)     'zinslengte in aantal TEKENS
        Selection.Collapse direction:=wdCollapseStart   'cursor terug op Beginpunt van de geselecteerde zin
       
        'onderstaande versie voor Fields van het type (36,2,14) :
        'textZinslengte = Mid(textfield, InStr((InStr(1, textfield, ",", 0) + 1), textfield, ",", 0) + 1, 3)

        'onderstaande versie voor Fields van het type (36-2.,14) :
        textZinslengte = Mid(textfield, InStr(1, textfield, ",", 0) + 1, 3)
        textAlineaZinsnummer = Left(textfield, InStr(1, textfield, ".,") - 1)
        
        nZinsLengte = CDec(textZinslengte)     'zinslengte in aantal (echte) WOORDEN
        
        IbeginNoPreviousMatch = 1   'ivm ordelijke gang van zaken bij meerdere concordanties in dezelfde zin
        
        'GROTE BINNENLUS (VOOR ALLE WOORDEN IN EEN ZIN):
        For jTekstWoord = 1 To nZinsLengte
        
        'wij houden aan, als basisprincipe:  SPATIE = WOORDGRENS
        If jTekstWoord = 1 Then
        'If jTekstWoord = 1 Then MsgBox "BEGIN of loop"    ' j=1 betekent: eerste woord van een zin
        Selection.Collapse direction:=wdCollapseEnd
        End If
        
115:    Lengte = Selection.MoveEndUntil(Cset:=" " & Chr(160) & vbCr & vbTab & vbLf & Chr(11) & Chr(12) & vbCrLf, Count:=50) - 1
        'hier en hieronder geldt altijd:  "Lengte" = lengte van het TekstWoord (straks ook na strippen van leestekens)
        'ook Tab, Linefeed, vbCr etc. gelden ALTIJD als woordgrens       '[*27-8-05: uitkomst van bovenstaand stmt bij lengte>50 is: lengte=-1 !]
        If Lengte > 50 Or Lengte = -1 Then  'Woordlengte (incl. sommige leestekens) is max. 50 !
        MsgBox "En la tekstfonto aperis vorto pli longa ol la permesita maksimumo (50 literoj)", _
          Title:="KVEK   -   makroo por konkordanc-listigo"
        End If
        If Lengte <> 0 Then GoTo 120   '[*corr. 27-8-05]
        'behandeling bij twee of meer spaties of andere formateringstekens achter elkaar:
        Selection.MoveWhile Cset:=" " & Chr(160) & vbCr & vbTab & vbLf & Chr(11) & Chr(12) & vbCrLf    'Ascii 160 is non-breaking space
        GoTo 115
120:    TekstWoord = Selection.Text
        Lengte = Len(TekstWoord)
        'afvangen van losstaande gedachtenstrepen en gespatieerde ellipsis:
        If TekstWoord = "-" Or TekstWoord = Chr(150) Or TekstWoord = "." Then     'Ascii 150 is lange gedachtenstreep
          jTekstWoord = jTekstWoord - 1    'correctie voor pseudo-woord dat door eerdere AZM macro niet is meegeteld in nZinsLengte
          'pseudo-woord oversprongen
          GoTo 160
        End If
               
        'VERWERKING PER TEKSTWOORD
        '(we hebben nu een TekstWoord te pakken, met mogelijk nog aangeplakte leestekens
        'aan beide zijden):
        '
        'afstrippen leestekens aan voorkant:
        DubbeleApostrofvoorWoord = False
235:    ChBegin = Left(TekstWoord, 1)
        VooraanGestript = False
        If Letter(ChBegin) Or Cijfer(ChBegin) Then GoTo 238
        Lengte = Lengte - 1      'strip leesteken aan voorkant
        If Lengte = 0 Then GoTo 290      'woord bestaat uit alleen maar leesteken(s)
        VooraanGestript = True
        TekstWoord = Right(TekstWoord, Lengte)
        If ChBegin = Chr(34) Then
            DubbeleApostrofvoorWoord = True  'hierna kan bijv. nog een Spaans vraagteken komen
            DubbeleUnderQuotevoorWoord = False
        End If
        If ChBegin = ChrW(8222) Then
            DubbeleApostrofvoorWoord = True
            DubbeleUnderQuotevoorWoord = True '*[behandeling ChrW(8222) toegevoegd op 2-9-03]
        End If
        GoTo 235
238:    'afstrippen leestekens aan achterkant:
        ChEnd = Right(TekstWoord, 1)
        AchteraanGestript = False
        If Letter(ChEnd) Or Cijfer(ChEnd) Then GoTo 240
        Lengte = Lengte - 1      'strip leesteken aan achterkant
        AchteraanGestript = True
        TekstWoord = Left(TekstWoord, Lengte)
        GoTo 238

240:    'afstrippen van leestekens voltooid,
        'we hebben nu een "schoon" TekstWoord gereed staan (kan overigens ook een cijferwoord zijn!)
        If Hoofdletter(ChBegin) = False Then GoTo 260
        'Woord begint met hoofdletter:
250:    'Speciale behandeling voor woorden met Hoofdletter(s):
        If jTekstWoord = 1 Or DubbeleApostrofvoorWoord Then 'uitzondering voor eerste woord van (grammaticale) zin
            If Not ConCordWordmetHoofdLetter Then
                TekstWoord = BeginHoofdletterWeg(TekstWoord)
                If jTekstWoord = 1 Then ZinsBuffer = BeginHoofdletterWeg(ZinsBuffer)
                If DubbeleApostrofvoorWoord Then
                If Not DubbeleUnderQuotevoorWoord Then ApostrofPos = InStr(1, ZinsBuffer, Chr(34))
                If DubbeleUnderQuotevoorWoord Then ApostrofPos = InStr(1, ZinsBuffer, ChrW(8222)) '*[toegevoedd op 2-9-03]
                If Not Letter(Mid(ZinsBuffer, ApostrofPos + 1, 1)) Then ApostrofPos = ApostrofPos + 1  'ivm bijv. Spaans vraagteken
                ZinsBuffer = Left(ZinsBuffer, ApostrofPos) & BeginHoofdletterWeg(Right(ZinsBuffer, nCharZinsLengte - ApostrofPos))
                End If
            'tenzij het een concordantie van eigennamen betreft, de hoofdletter omzetten in kleine letter (om geen match te missen)
            End If
        End If
        GoTo 260 'Woorden met hoofdletters die NIET aan het begin van een (grammaticale) zin staan,
        ' worden in dit concordantie-macro zo behandeld dat hun hoofdletter altijd gehandhaafd blijft
        ' en dat gebruikers op deze manier ook concordanties van eigennamen en acronymen kunnen verkrijgen;
        ' in deze EIGENNAAM-CONCORDANTIES komen OOK de eigennamen die toevallig aan het begin van een zin staan.
        ' Gebruikers kunnen overigens ook concordanties van cijferwoorden verkrijgen.
             
260:
    'Beregeling instap- en uitstap- waarden van de FlectEndings-array:
    If Clean Then
        EndingFirst = 1
        EndingLast = 1
    End If
    If NounFlect Then
        EndingFirst = 1
        EndingLast = 5
    End If
    If AdjFlect Then
        EndingFirst = 6
        EndingLast = 10
    End If
    If AdvFlect Then
        EndingFirst = 11
        EndingLast = 13
    End If
    If VerbFlect Then
        EndingFirst = 14
        If extra36 Then EndingLast = 74 Else EndingLast = 38
    End If
        
    If AllCatEndings Then
        EndingFirst = 1
        If extra36 Then EndingLast = 74 Else EndingLast = 38
    End If
    
'----------------------------------------------------------------------------------------
'DO-loop die 1 x (Clean), 5 x (Truncated + 4 Endings ingeval Flection) of meer doorlopen wordt:
For k = EndingFirst To EndingLast
                
    If Not Clean Then
        ConCordWord = Stem & FlectEnding(k)
        LenConCord = Len(ConCordWord)
    End If
        
        
        'MATCHING met een volledig WOORD:
261:
        If Not Clean And FlectEnding(k) = "" Then GoTo 2610 '(kale stam kan alleen op deelwoord matchen)
        If ConCordWord = TekstWoord Then
            If Not (Prefikso Or Sufikso) Then
                GoTo 263    'volledige woord-match
            Else: GoTo 269  'bij Prefikso/Sufikso telt een volledige woordmatch NIET!
            End If
        End If
        
        'MATCHING met een woordDEEL:
        If Clean Or ConCordWord = Right(TekstWoord, LenConCord) Then GoTo 2610
        '(tenzij woordDEEL = woordEINDE, beperk het aantal Flectie-varianten in samenstellingen:)
        If NounFlect And Not FlectEnding(k) = "o" Then GoTo 269  'geen meervoud of accusatief toegestaan
        If AdjFlect And Not FlectEnding(k) = "a" Then GoTo 269   'geen meervoud of accusatief toegestaan
        If AdvFlect And Not (FlectEnding(k) = "e" Or FlectEnding(k) = "en") Then GoTo 269
        If VerbFlect And Not FlectEnding(k) = "i" Then GoTo 269  '-i is discutabel (zie PAG blz.419)
        
2610:   IbeginConCordWord = InStr(1, TekstWoord, ConCordWord)
        If IbeginConCordWord <= 0 Then GoTo 269  'helemaal geen match, ook geen deelmatch
        If Prefikso And IbeginConCordWord <> 1 Then GoTo 269  'geen prefix-match
        IendConCordWord = IbeginConCordWord + LenConCord - 1
        If Sufikso And IendConCordWord <> Lengte Then GoTo 269  'geen suffix-match
        If VortParto Then GoTo 263  'woordDEEL-match, ZONDER verplicht gebruik van hyphen
        
        'MATCHING met een woordDEEL, bij deelwoord-koppeling via hyphen:
        If Prefikso And IbeginConCordWord = 1 Then  '(match met linkerkant Tekstwoord)
            If IendConCordWord <= Lengte - 2 And Mid(TekstWoord, IendConCordWord + 1, 1) = "-" Then
            '(is rechts via hyphen gekoppeld aan rest TekstWoord)
            GoTo 263  'deelmatch MET hyphen-koppeling
            End If
        End If
        If Sufikso And IbeginConCordWord >= 3 Then
            If Mid(TekstWoord, IbeginConCordWord - 1, 1) = "-" Then
                '(is links via hyphen gekoppeld aan rest TekstWoord)
                If IendConCordWord = Lengte Then '(match met rechterkant Tekstwoord)
                GoTo 263  'deelmatch MET hyphen-koppeling
                End If
            End If
        End If
262:    If Not Prefikso And Not Sufikso And IbeginConCordWord <> 2 And IendConCordWord <> Lengte - 1 Then
            If IbeginConCordWord >= 3 Then
                If Mid(TekstWoord, IbeginConCordWord - 1, 1) <> "-" Then GoTo 269  'geen deelmatch
            End If
            'matcht met linkerkant Tekstwoord, of is links via hyphen gekoppeld aan rest TekstWoord
            If IendConCordWord <= Lengte - 2 Then
                If Mid(TekstWoord, IendConCordWord + 1, 1) <> "-" Then GoTo 269  'geen deelmatch
            End If
            'matcht met rechterkant Tekstwoord, of is rechts via hyphen gekoppeld aan rest TekstWoord
            GoTo 263  'deelmatch MET hyphen-koppeling
        End If
        GoTo 269   'geen deelmatch
                                     
                   
263:
        'TREFFER, succesvolle matching:
        '(wordt opgeslagen in de kolom 3 van de output-lijst):
        iLijstConcordWord = iLijstConcordWord + 1
        WstatLijstConcordWord(iLijstConcordWord, 1) = BronCode & " " & textAlineaZinsnummer
        WstatLijstConcordWord(iLijstConcordWord, 3) = ConCordWord     'ConCordWord aangetroffen in TekstWoord
        GoTo 271

269:
        '(nog) geen match;
        If Clean Then GoTo 160  'spring uit de K-loop
        'if not clean, probeer het dan eens met de volgende Flect-variant

Next k  'Onderkant DO-loop
'------------------------------------------------------------------------
'Op alle Flect-varianten van het InputWord is nu getest!
GoTo 160 '(geen match)


271:
        'Extraheren van de Microcontext uit de ZinsBuffer
        '(hierboven ging het plaatsbepaling van het ConCordWord op of in een TekstWoord,
        'hieronder gaat het om de plaatsbepaling binnen de ruimere context van een zin):

        'Opsplitsen ZinsBuffer:
        IbeginConCordWord = InStr(IbeginNoPreviousMatch, ZinsBuffer, ConCordWord, 0)
        If IbeginConCordWord = 0 Then IbeginConCordWord = InStr(IbeginNoPreviousMatch, ZinsBuffer, ConCordWord, 1)
        IendConCordWord = IbeginConCordWord + LenConCord - 1
        
        'Linker- en Rechter- microcontexten bepalen, met inachtneming van:
        '       i. zinsgrens (=zinsbuffergrens)
        '      ii. bij begin macro aangegeven max. aantal tekens (bijv. 40)
        '     iii. microcontext mag niet middenin een woord beginnen of ophouden
        '          (behalve op de hyphen bij samengestelde woorden)
        '          (en behalve in een klein aantal uitzonderingsgevallen bij de Rechter microcontext,
        '            waarbij dan drie puntjes [...] achter de microcontext worden toegevoegd) [18-8-05]
        
        'Linker microcontext:
272:    LenLinkerKant = IbeginConCordWord - 1  'incl. spatie en leestekens vooraan ConcordWord
        LenRechterKant = nCharZinsLengte - IendConCordWord  'incl. spatie en leestekens achteraan ConcordWord!
        If LenLinkerKant <= 0 Then   '(Linker MicroContext ontbreekt)  '** <=0 ipv =0 aangebracht op 2-9-03
         WstatLijstConcordWord(iLijstConcordWord, 2) = ""
         GoTo 273
        End If
        'Tenzij de gebruiker hierom gevraagd heeft (middels de parameter VortParto) wordt
        'matching van een woordDEEL (behalve wanneer gekoppeld met hyphen) NIET als concordantie beschouwd:
        If ((Not VortParto) Or Prefikso) Then
            If Letter(Mid(ZinsBuffer, LenLinkerKant, 1)) Then GoTo 277
            If Prefikso And LenRechterKant <> 0 Then
                If Not Letter(Mid(ZinsBuffer, IendConCordWord + 1, 1)) Then GoTo 277
            End If
        End If
        LinkerKantZin = Left(ZinsBuffer, LenLinkerKant)
        If LenLinkerKant <= nmaxMicroContextLeft Then
        MicroContext = LinkerKantZin
        Else
        MicroContext = Right(LinkerKantZin, nmaxMicroContextLeft)
        MicroContext = Right(MicroContext, nmaxMicroContextLeft - InStr(1, MicroContext, " "))
        End If
        'Van de meestrechtse spatie in de Linker Microcontext wordt een dubbele spatie gemaakt,
        'om optische redenen (duidelijker zichtbaarheid van aan het ConCordWord aangeplakte woorddelen of leestekens):
        m = InStrRev(MicroContext, " ", -1)  '(de geretourneerde waarde van InstrRev is gewoon vanaf LINKER stringbegin gerekend!)
        If m <> 0 Then MicroContext = Left(MicroContext, m) & " " & Right(MicroContext, Len(MicroContext) - m)
        'Opslaan in uitvoerlijst:
        WstatLijstConcordWord(iLijstConcordWord, 2) = MicroContext   'Microcontext Links
        
        'Rechter microcontext:
273:    If LenRechterKant = 0 Then   '(Rechter MicroContext ontbreekt)
        WstatLijstConcordWord(iLijstConcordWord, 4) = ""
        GoTo 276
        End If
        'Tenzij de gebruiker hierom gevraagd heeft (middels de parameter VortParto) wordt
        'matching van een woordDEEL (behalve wanneer gekoppeld met hyphen) NIET als concordantie beschouwd:
        If ((Not VortParto) Or Sufikso) Then
            If Letter(Mid(ZinsBuffer, IendConCordWord + 1, 1)) Then GoTo 277
            If Sufikso And LenLinkerKant <> 0 Then
                If Not Letter(Mid(ZinsBuffer, IbeginConCordWord - 1, 1)) Then GoTo 277
            End If
        End If
        RechterKantZin = Right(ZinsBuffer, LenRechterKant)
        If LenRechterKant <= nmaxMicroContextRight Then
            MicroContext = RechterKantZin
        Else
            InStrNmaxRechts = InStr(nmaxMicroContextRight, RechterKantZin, " ")
            '(door de rechtsgerichtheid van Instr zijn de coderingen voor Linker en Rechter MicroContext niet symmetrisch!)
            InStrNmaxRechtsNul = False  '[toevoegingen 18-8-05]
            If InStrNmaxRechts = 0 Then  'ipv laten doorlopen tot spatie (die er niet is!), afkappen op nmax en "..." toevoegen:
                'MsgBox ("kleine complicatie rechter context bij  " & WstatLijstConcordWord(iLijstConcordWord, 1))
                InStrNmaxRechts = nmaxMicroContextRight
                InStrNmaxRechtsNul = True
            End If
            MicroContext = Left(RechterKantZin, InStrNmaxRechts)
            If InStrNmaxRechtsNul Then MicroContext = MicroContext & "..."
        End If
        'Van de meest linkse spatie in de Rechter Microcontext wordt een dubbele spatie gemaakt,
        'om optische redenen (duidelijker zichtbaarheid van aan het ConCordWord aangeplakte woorddelen of leestekens):
        m = InStr(1, MicroContext, " ")
        If m <> 0 Then MicroContext = Left(MicroContext, m) & " " & Right(MicroContext, Len(MicroContext) - m)
        'Opslaan in uitvoerlijst:
        WstatLijstConcordWord(iLijstConcordWord, 4) = MicroContext   'Microcontext Rechts

        'dit macro werkt ook correct bij ConCordWord pal aan begin of aan einde van zin;
        'als het ConCordWord aan het begin van de zin staat, wordt het in de uitvoerlijst
        ' NIET met een hoofdletter vermeld, tenzij het een eigennaam is;
        'aan einde zin wordt WEL de punt (of vraagteken, uitroepteken) als microcontext opgenomen!

276:
        'Teller e.d. bijhouden:
        WstatnConcordWord = WstatnConcordWord + 1
        IbeginNoPreviousMatch = IendConCordWord + 2   'opschuiven beginpunt matching ivm evt volgende concordanties in dezelfde zin
        GoTo 160
277:
        IbeginNoPreviousMatch = IendConCordWord + 2   'opschuiven beginpunt matching ivm evt volgende concordanties in dezelfde zin
        GoTo 271    'zoek in dezelfde ZinsBuffer verder, naar de volgende (volledig matchende) occurence van ConCordWord

290:    '(Woord bestaat alleen maar uit Leestekens:)

160:  If WstatnConcordWord = 1500 Then
         MsgBox "La listig-kapacito de KVEK atingis sian maksimumon: 1500 konkordancojn;" & vbCr & _
                      "la makroo ne plu prisercxos la font-dosieron.", _
           Title:="KVEK   -   makroo por konkordanc-listigo"
         GoTo 666  'voortijdig stoppen (einde document is wschl. nog niet bereikt)
        End If
        'N.B. bij voortijdig stoppen (wat midden in een zin kan zijn) zullen de aangegeven waarden van
        'WstatnAantalZinnen en WstatnTotaalAanZinslengten niet exact zijn (afwijking van 1 resp. ca. 15)

166:    'Afsluiting van deze doorgang door jTekstWoord-loop en voorbereiding voor evt. volgende woord:
        If jTekstWoord <> nZinsLengte Then
        Selection.Collapse direction:=wdCollapseEnd
        'Selection.MoveStartUntil Cset:=" ", Count:=50
        Selection.MoveStart unit:=wdCharacter, Count:=1
        End If
        Next jTekstWoord   'ONDER-EIND VAN BINNENLUS
        
   'Einde van zin:
    WstatnAantalZinnen = WstatnAantalZinnen + 1
    WstatnTotaalAanZinslengten = WstatnTotaalAanZinslengten + nZinsLengte
    'If MsgBox("EINDE van zin " & WstatnAantalZinnen & ",   doorgaan naar volgende?", vbYesNo) = vbNo Then GoTo 999
    Next iZin   'ONDER-EIND VAN BUITENLUS
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToLast, Count:=1, Name:=""  'cursor aan einde file zetten
    
    
666:
'Einde van document bereikt   -    Eindbehandeling
'   Zet cursor weer aan begin file:
    Selection.Collapse
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""

'=========================================================================

990:
'MsgBox "Ekiro de daten-transporto al Excel:" & vbCr & _
'       "ATENTU   -   certigu ke jena Excel-dosiero estas malfermita:" & vbCr & vbCr & _
'       "C:\ESPSOF\ESPSOF-KVEK.xls" & vbCr & vbCr & vbCr & _
'       "se tiu dosiero ne malfermitas, la jhus produktita konkordanco perdighos!"

Set WstatWordtoExcel = GetObject("C:\ESPSOF\ESPSOF-KVEK.xls")
        'ATTENTIE: de Excel-file met deze naam moet wel tevoren GEOPEND zijn,
        'maar hoeft niet per se 'actief' te zijn (als er meerdere Excel-files geopend zijn).

'Check op evt. Offset-terugzetten door gebruiker (betreft zowel Sheet1 als Sheet2):
With WstatWordtoExcel.worksheets(2)
If .Cells(2, 1).Value < OffSet Then
    If .Cells(2, 1).Value < 2 Or .Cells(2, 1).Value = "" Then
        .Cells(2, 1).Value = 2    'value=1 not allowed; row 1 is reserved for headings;
        If OffSet = 2 Then
            UserChangedOffset = False  'merely an accidentally destroyed start-value in Cel(2,1),...
            GoTo 99009
        End If   '...otherwise, user has reset from some value ( >2), but erroneously to 0 or 1 instead to 2;
    End If
    UserChangedOffset = True
    PreviousOffset = OffSet 'dient voor een efficient deleten van eerder materiaal
Else
    UserChangedOffset = False
End If
99009:
'If .Cells(2, 1).Value > OffSet Then
OffSet = .Cells(2, 1).Value
'Cel(2,1) is de voor de gebruiker steeds zichtbare AANDUIDING...
'...van de eerstvolgende lege ('vrijgegeven') rij waarop 2 regels tussenruimte...
'...plus een concordantieblok zullen beginnen.
'Gebruiker mag de Offset niet alleen terug- maar ook vooruitzetten.
End With

'Algemene overzichtsgegevens worden gepresenteerd op Sheet 1:
With WstatWordtoExcel.worksheets(1)
'Herstel headings dosier-overzicht indien ze (deels en per-ongeluk) ge-delete zijn:
If .Cells(1, 7).Value = "" Or .Cells(2, 6).Value = "" Then
.Cells(1, 7).Value = "Uzita(j) Tekstfonto(j)"
.Cells(1, 7).Font.Fontstyle = "Bold Underlined"
.Cells(2, 6).Value = "dosierkodo"
.Cells(3, 6).Value = "nombro da esploritaj frazoj:"
.Cells(4, 6).Value = "totalo de esploritaj frazlongoj (nombro da esploritaj tekstvortoj):"
.Cells(7, 6).Value = "vidu la konkordancon mem en Folio 2  !"
.Cells(7, 6).Font.Fontstyle = "Bold Italic"
End If
BronCodeAlsnogVernieuwd = False  '(deze Boolean alleen ivm Broncode-wisseling na verschil in lengte Brontekst)
If UzFontkolom = 0 Or .Cells(2, 7).Value = "" Then
    UzFontkolom = 7
ElseIf BronCode <> PreviousBroncode Then  'bij wisseling van Broncode (andere bron-file),
    UzFontkolom = UzFontkolom + 1               'nieuwe kolom voor 3 TekstBron-gegevens beginnen
ElseIf WstatnTotaalAanZinslengten <> PreviousWstatnTotaalAanZinslengten Then
    If PreviousWstatnTotaalAanZinslengten > 0 Then  '(geen aktie bij eerste door macro behandelde bron-file)
        UzFontkolom = UzFontkolom + 1               'alsnog wisseling Broncode mogelijk, ivm verschil in lengte Brontekst
        AlsnogNieuweBronCode = Left(InputBox("La uzita tekstfonto shajne shanghighis.  Estas rekomendinde" & vbCr & _
        "nun shanghi jenan (8-literan) dosierkodon:", "Konkordanco  -  KVEK", BronCode), 8)
        If AlsnogNieuweBronCode <> BronCode Then
        BronCode = AlsnogNieuweBronCode
        BronCodeAlsnogVernieuwd = True
        End If
    End If
End If
'Vul dosiergegevens in (altijd, ook als er geen dosierwisseling heeft plaatsgevonden):
.Cells(2, UzFontkolom).Value = BronCode
.Cells(2, UzFontkolom).Font.Fontstyle = "Italic"
.Cells(3, UzFontkolom).Value = WstatnAantalZinnen
.Cells(4, UzFontkolom).Value = WstatnTotaalAanZinslengten
PreviousWstatnTotaalAanZinslengten = WstatnTotaalAanZinslengten

'Herstel headings history-overzicht indien ze (deels en per-ongeluk) ge-delete zijn:
If .Cells(9, 4).Value = "" Or .Cells(10, 1).Value = "" Then
.Cells(9, 4).Value = "Historio de konkordanc-specifoj"
.Cells(9, 4).Font.Fontstyle = "Bold Underlined"
.Cells(10, 1).Value = "eka vico"
.Cells(10, 2).Value = "fina vico"
.Cells(10, 3).Value = "konkord."
.Cells(10, 4).Value = "vorto a" & ChrW(365) & " vortero"
.Cells(10, 5).Value = "maldekstr"
.Cells(10, 6).Value = "dekstra"
.Cells(10, 7).Value = "36 aldon."
.Cells(10, 8).Value = "PARTO"
.Cells(10, 9).Value = "anta" & ChrW(365) & "a"
.Cells(10, 10).Value = "dosiero"
End If
For j = 11 To 1010  'er worden maximaal 1000 history-regels opgeslagen (voor elke makro-aanroep 1)
If .Cells(j, 1).Value = "" Or .Cells(j, 4).Value = "" Then GoTo 99011
Next j  '(indien 1000 regels zijn opgeslagen, wordt rij 1011 wordt steeds weer door een volgende overschreven)
99011:
SekvaRondo = j  'eerstvolgende lege rij zal worden gebruikt voor opslag history-regel
.Range(.Cells(j, 1), .Cells(1010, 10)).ClearContents   'veiligheidshalve vanaf daar eerst alles deleten
If WstatnConcordWord <> 0 Then
    .Cells(SekvaRondo, 1).Value = OffSet + 2  'altijd 2 rijen tussenruimte voorafgaand aan nieuw concordantie-blok
    .Cells(SekvaRondo, 2).Value = OffSet + WstatnConcordWord + 1
Else
    .Cells(SekvaRondo, 1).Value = 0
    .Cells(SekvaRondo, 2).Value = 0
End If
.Cells(SekvaRondo, 3).Value = WstatnConcordWord
.Cells(SekvaRondo, 4).Value = InputWord
.Cells(SekvaRondo, 5).Value = microcontextlengtelinks
.Cells(SekvaRondo, 6).Value = microcontextlengterechts
If extra36 Then .Cells(SekvaRondo, 7).Value = "*"
If VortParto And Not Prefikso Then .Cells(SekvaRondo, 8).Value = "*"
If Prefikso Then .Cells(SekvaRondo, 9).Value = "*"
.Cells(SekvaRondo, 10).Value = BronCode
.Cells(SekvaRondo, 10).Font.Fontstyle = "Italic"
End With

'De Concordanties (met bijbehorende microcontexten) zelf komen op Sheet 2:
With WstatWordtoExcel.worksheets(2)
'Herstel headings indien ze (deels en per-ongeluk) ge-delete zijn:
If .Cells(1, 1).Value = "" Or .Cells(1, 2).Value = "" Then
.Cells(1, 1).Value = "Fonto"
.Cells(1, 1).Font.FontSize = 8
.Cells(1, 1).Font.Fontstyle = "Bold Italic"
.Cells(1, 2).Value = "maldekstra kunteksto"
.Cells(1, 3).Value = "KVEK"
.Cells(1, 4).Value = "dekstra kunteksto"
.Range(.Cells(1, 2), .Cells(1, 4)).Font.Fontstyle = "Bold"
End If
'In geval van door de gebruiker [ in Cell(2,1)]  teruggezette Offset-waarde:
If UserChangedOffset Then
    .Range(.Cells(OffSet, 1), .Cells(PreviousOffset - 1, 4)).ClearContents
    '(veiligheidshalve deleten, maar wel efficient: alleen over het 'teruggezette' bereik)
End If
'Evt. dosiercodes vernieuwen:
If BronCodeAlsnogVernieuwd Then  '(indien Broncode vernieuwd na vaststelling verschil in Brontekstlengte)
    For j = 1 To WstatnConcordWord   'het filenaam-gedeelte van de dosierkodes wordt alsnog vernieuwd
    WstatLijstConcordWord(j, 1) = BronCode & " " & _
    Right(WstatLijstConcordWord(j, 1), Len(WstatLijstConcordWord(j, 1)) - InStr(1, WstatLijstConcordWord(j, 1), " "))
    Next j
End If
'Plaats het nieuwe Concordantie-blok:
If WstatnConcordWord <> 0 Then
    OffSet = OffSet + 1  '(zodat bij j=1 eerste woord concordantie-blok begint op Offset+2)
    For j = 1 To WstatnConcordWord   'er zijn maxinaal zo'n. 30.000 rijen beschikbaar voor Concordanties
        .Cells(OffSet + j, 1).Value = WstatLijstConcordWord(j, 1)
        .Cells(OffSet + j, 2).Value = WstatLijstConcordWord(j, 2)
        .Cells(OffSet + j, 3).Value = WstatLijstConcordWord(j, 3)
        .Cells(OffSet + j, 4).Value = WstatLijstConcordWord(j, 4)
    Next j
    'Bereken alvast de plaats voor het evt. volgend concordantie-blok en deel die mee via cel(2,1)
    OffSet = OffSet + WstatnConcordWord + 1   '(beginnend met 2 lege rijen tussenruimte)
    .Cells(2, 1).Value = OffSet
    End If
End With

MsgBox "La rezultoj jhus eniris en la EXCEL-dosieron 'ESPSOF-KVEK'" & vbCr & _
              "(kondiche ke tiu dosiero estis malfermita!)." & vbCr & vbCr & _
              "Uzu la Excel-dosieron por prezentado kaj eventuala plua prilaborado (reordigo).", _
 Title:="KVEK   -   makroo por konkordanc-listigo"
Set WstatWordtoExcel = Nothing    'deze macro sluit het kanaal naar Excel weer af

BrontekstFilenaam = ActiveDocument.Name  '[11-3-2008]

999:
End Sub

'ESPSOF Versio 0.8    15 Marto 2008 TW (Toon Witkam)

'================================================================================================

'               2 0    F U N K C I O J      P O R     S I G N O C X E N O J      K A J      C I F E R O J

'================================================================================================

'tiuj chi funkcioj estas subordigitaj al  - kaj bezonataj de -  la baza kaj chefaj aplikaj programoj de
'ESPSOF:  AFMBazo, TEKSTanal, KVEK


'*[deze  FUNCTIES VOOR STRING- EN CIJFER-verwerking hebben een exacte kopie
'  als gelijknamige functies in mijn VBA-Excel macro-reservoir;  veranderingen daarom
'  ALTIJD KOPIEREN, zodat er geen 2 verschillende versies gelijktijdig bestaan! ]

'----------------------------------------------------------------------------------------------------------------------------------------

Function Letter(ch As String) As Boolean
'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
If Hoofdletter(ch) Or KleineLetter(ch) Then
Letter = True
Else
Letter = False
End If
End Function
Function Hoofdletter(ch As String) As Boolean
'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim L As Integer
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 65 And L <= 90) Or (L >= 192 And L <= 222 And L <> 215) Then
Hoofdletter = True
ElseIf ((L >= 256 And L <= 311) Or (L >= 330 And L <= 375)) And Even(L) Then
Hoofdletter = True
ElseIf (L = 313 Or L = 315 Or L = 317 Or L = 319 Or L = 321 Or L = 323 Or L = 325 Or L = 327) Or _
(L = 376 Or L = 377 Or L = 379 Or L = 381 Or L = 383) Then
Hoofdletter = True
Else
Hoofdletter = False
End If
End Function
Function BeginHoofdletterWeg(inputstring As String) As String
'Van een inputstring met een evt. beginhoofdletter wordt een ongekapitaliseerde
'versie teruggegeven via de functienaam zelf.

'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim L As Integer
Dim StringLength As Integer
Dim ch As String
StringLength = Len(inputstring)
ch = Left$(inputstring, 1)    'beginletter
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 65 And L <= 90) Or (L >= 192 And L <= 221) Then   'hoofdletter vervangen door kleine letter
    L = L + 32
    BeginHoofdletterWeg = ChrW(L) & Right$(inputstring, StringLength - 1)
ElseIf ((L >= 256 And L <= 375) And Even(L)) Or _
           ((L >= 377 And L <= 382) And Not Even(L)) Then
    L = L + 1
    BeginHoofdletterWeg = ChrW(L) & Right(inputstring, StringLength - 1)
Else
    BeginHoofdletterWeg = inputstring    '(geen hoofdletter aangetroffen)
End If
End Function
Function VolgHoofdlettersWeg(inputstring As String) As String
'Van een inputstring die geheel uit hoofdletters bestaat worden alle hoofdletters behalve de beginhoofdletter
'omgezet naar kleine letters;   de veranderde versie wordt teruggegeven via de functienaam zelf.

'ook als de inputstring niet of slechts ten dele uit hoofdletters bestaat, worden alle eventuele hoofdletters, behalve
'de eventuele beginhoofdletter, omgezet naar kleine letters; voorzover er in de inputstring reeds kleine letters zaten, blijven die gewoon staan.

'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim i As Integer
Dim L As Integer
Dim StringLength As Integer
Dim ch As String
StringLength = Len(inputstring)
VolgHoofdlettersWeg = inputstring
For i = 2 To StringLength
ch = Mid$(inputstring, i, 1)    '2e (of 3e, 4e, etc) letter
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 65 And L <= 90) Or (L >= 192 And L <= 221) Then   'hoofdletter vervangen door kleine letter
    L = L + 32
    VolgHoofdlettersWeg = Left$(VolgHoofdlettersWeg, i - 1) & ChrW(L) & Right$(VolgHoofdlettersWeg, StringLength - i)
ElseIf ((L >= 256 And L <= 375) And Even(L)) Or _
           ((L >= 377 And L <= 382) And Not Even(L)) Then
    L = L + 1
    VolgHoofdlettersWeg = Left$(VolgHoofdlettersWeg, i - 1) & ChrW(L) & Right$(VolgHoofdlettersWeg, StringLength - i)
End If
Next i
End Function

Function WildeHoofdlettersWeg(woord As String, weggehaald As Boolean) As String
'Van een woord met evt. WILDE hoofdletters wordt een ongekapitaliseerde
'versie teruggegeven via de functienaam zelf.
'Een beginhoofdletter blijft altijd behouden, ook als daarna wilde hoofdletters voorkomen.
'Het macro moet  worden toegepast op een woord ZONDER de
'eraan voorafgaande spatie of leestekens!
'
'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim i As Integer
Dim L As Integer
Dim k As Integer
Dim ch As String
Dim AllemaalKleineLetters As Boolean
Dim AllemaalHoofdletters As Boolean
'Onderzoekt een woord op hoofdletters, en vervangt evt. WILDE hoofdletters door kleine letters..
'Als NIET-WILD wordt beschouwd:
'       - alleen de EERSTE letter van het woord is een hoodfletter;
'       - ALLE letters van het woord (dus NIET cijfers, verbindingstekens etc) zijn hoofdletters.
'Als WILD wordt beschouwd:
'       - alle andere voorkomens van hoofdletters (dus bijv. een eenzame hoofdletter middenin een woord,
'       - de eerste twee letters van een meerletterwoord zijn hoofdletters , etc)
'Indien hyphens in een woord voorkomen, bijv. 'NAVO-commissie-vergadering', beperkt het macro zich
'tot het ontwilderen van het woorddeel voor het eerste hyphen. De Nederl. "IJ" aan woordbegin blijft staan.
'
WildeHoofdlettersWeg = woord
weggehaald = False
'Onderzoek of er wilde hoofdletters zijn:
L = Len(woord)
If L > 50 Then
MsgBox "dit macro is er voor WOORDEN, niet voor tekstblokken!"
GoTo geenwild  '(bescherming tegen onbedoelde beschadiging van tekstblokken)
End If
If L = 1 Then GoTo geenwild  '1-letter woord kan nooit wilde hoofdletter zijn
AllemaalKleineLetters = True
For i = 2 To L  'eerste letter mag hoofdletter zijn
ch = Mid(woord, i, 1)
If ch = "-" Then GoTo 11  'kijk niet verder dan eerst optredende hyphen
If Hoofdletter(ch) Then AllemaalKleineLetters = False
Next i
11:
If AllemaalKleineLetters Then GoTo geenwild
'Sta woorden-geheel-in-hoofdletters toe:
AllemaalHoofdletters = True
For i = 1 To L  'eerste letter mag GEEN kleine letter zijn
ch = Mid(woord, i, 1)
If ch = "-" Then GoTo 12  'kijk niet verder dan eerst optredende hyphen
If KleineLetter(ch) Then AllemaalHoofdletters = False
Next i
12:
If AllemaalHoofdletters Then GoTo geenwild
'
'Vervang wilde hoofdletters door kleine letters:
For i = 2 To L  'vervanging vanaf letter 2, want een evt. beginhoofdletter blijft altijd behouden
ch = Mid$(woord, i, 1)    'i-de letter van woord
If i = 2 And ch = "J" And Left(woord, 1) = "I" Then GoTo 13  'uitzondering voor Nederl. "IJ" aan begin woord
If ch = "-" Then GoTo geenwild  'stop hoofdlettervervanging bij eerst optredende hyphen
k = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
'Hoofdlettervervanging in Basic-Latin of in Latin-1:
If (k >= 65 And k <= 90) Or (k >= 192 And k <= 222) Then   'hoofdletter vervangen door kleine letter
    k = k + 32
    WildeHoofdlettersWeg = Left$(WildeHoofdlettersWeg, i - 1) & ChrW(k) & Right$(WildeHoofdlettersWeg, L - i)
End If
'Hoofdlettervervanging in Latin-Extended-A:
If ((k >= 256 And k <= 382) And Even(k)) Then
    k = k + 1
    WildeHoofdlettersWeg = Left$(WildeHoofdlettersWeg, i - 1) & ChrW(k) & Right$(WildeHoofdlettersWeg, L - i)
End If
weggehaald = True
13:
Next i
geenwild:
End Function

Function HaalHyphensWeg(inputstring As String) As String
'Deze macro is taalonafhankelijk.
'Van een inputstring in met evt. ingebedde hyphens ("directeur-generaal", "�ef-episkopo", ...)
'worden de hyphens verwijderd.
'De aldus gewijzigde string wordt geretourneerd via de functienaam zelf.

Dim StringLengthMin1 As Integer
Dim i As Integer
Dim k As Integer
Dim ch As String

HaalHyphensWeg = inputstring
StringLengthMin1 = Len(HaalHyphensWeg)
i = 1
zoekhyphen:
k = i + 1                               'hyphen aan begin van collocatie wordt NIET verwijderd;
StringLengthMin1 = StringLengthMin1 - 1 'hyphen aan eind van collocatie wordt NIET verwijderd;
                                        'bij 2 hyphens naast elkaar wordt de tweede NIET verwijderd!
For i = k To StringLengthMin1 'i-loop: zoek tot het volgende hyphen:
    ch = Mid$(HaalHyphensWeg, i, 1)
    If ch = "-" Then
        HaalHyphensWeg = Left$(HaalHyphensWeg, i - 1) & Right$(HaalHyphensWeg, StringLengthMin1 + 1 - i)
        GoTo zoekhyphen 'spring uit deze i-loop en begin aan een nieuwe voor de rest van de string
    End If
Next i
End Function
Function HaalOptionalHyphensWegUitWoord(inputstring As String, OptionalHyphen As Boolean) As String

'TW  4-9-08

'Deze macro is taalonafhankelijk.
'Van een inputstring met evt. ingebedde OPTIONAL hyphens (ASCII-code 31)
'worden deze optional hyphens verwijderd. Optional hyphens dienen in teksten voor
'het automatisch afbreken van lange woorden aan regeleinde, zonder dat die hyphens
'zichtbaar zijn als diezelfde woorden toevallig middenin een regel komen te staan.
'Het verwijderen van optional hyphens kan nodig zijn bij Wstat-software wanneer
'uit teksten gedistilleerde woorden in Excel-woordenlijsten komen te staan, want
'in Excel verschijnen de optional hyphens dan als hinderlijk vierkant blokje middenin
'de woordstring.

'De aldus gewijzigde string wordt geretourneerd via de functienaam zelf.

Dim StringLengthMin1 As Integer
Dim i As Integer
Dim k As Integer
Dim ch As String

OptionalHyphen = False  'defaults   '[de parameter 'optionalhyphen' is op 4-9-08 toegevoegd]
HaalOptionalHyphensWegUitWoord = inputstring

StringLengthMin1 = Len(HaalOptionalHyphensWegUitWoord)
i = 1
zoekhyphen:                             'er kunnen meer optional hyphens in 1 woord voorkomen;
k = i + 1                               'optional hyphen aan begin van woord komt niet voor;
StringLengthMin1 = StringLengthMin1 - 1 'optional hyphen aan eind van woord komt niet voor;
                                        '2 optional hyphens naast elkaar komen niet voor;
For i = k To StringLengthMin1 'I-loop: zoek tot het volgende hypen:
    ch = Mid$(HaalOptionalHyphensWegUitWoord, i, 1)
    If ch = Chr(31) Then      '031 is de ASCII-code van optional hyphen
        OptionalHyphen = True  '[de parameter 'optionalhyphen' is op 4-9-08 toegevoegd]
        HaalOptionalHyphensWegUitWoord = Left$(HaalOptionalHyphensWegUitWoord, i - 1) & Right$(HaalOptionalHyphensWegUitWoord, StringLengthMin1 + 1 - i)
        GoTo zoekhyphen 'spring uit deze I-loop en begin aan een nieuwe voor de rest van de string
    End If
Next i
End Function
Function HaalMORDISWeg(inputstring As String) As String
'Deze macro haalt alle MORDIS-tekens uit de inputstring
'De aldus gewijzigde string wordt geretourneerd via de functienaam zelf.

Dim StringLengthMin1 As Integer
Dim i As Integer
Dim k As Integer
Dim ch As String

HaalMORDISWeg = inputstring
StringLengthMin1 = Len(HaalMORDISWeg)
i = 1
zoekMORDIS:
k = i + 1     'er wordt van uit gegaan dat er GEEN  MORDIS staat aan het begin van de inputstring,...
StringLengthMin1 = StringLengthMin1 - 1   '...en ook GEEN MORDIS aan het eind van de inputstring !
                  'bij 2 MORDIS-tekens naast elkaar wordt de tweede NIET verwijderd !
For i = k To StringLengthMin1   'I-loop: zoek tot het volgende MORDIS-teken:
    ch = Mid(HaalMORDISWeg, i, 1)
    If ch = ChrW(183) Or ch = ChrW(65123) Then  'het gaat om het MORDIS (Morfem-Disigilo) -teken: Unicode 183 of 65123  [30-9-2008]
        HaalMORDISWeg = Left(HaalMORDISWeg, i - 1) & Right(HaalMORDISWeg, StringLengthMin1 + 1 - i)
        GoTo zoekMORDIS 'spring uit deze I-loop en begin aan een nieuwe voor de rest van de string
    End If
Next i
End Function
Function HaalSpatiesWegUitWoord(inputstring As String) As String
'Deze macro is taalonafhankelijk.
'Van een inputstring met spaties ingebed tussen de letters ("  p r o f e s i a n ", "  e f e k t i v e", ...)
'worden de spaties verwijderd. Dit is speciaal van belang voor woorden die in een (ingescande) tekst ge-highlight
'zijn middels ingebedde spaties, en dus een probleem opleveren bij verwerking door AZM-Wstat software.
'De ineengeschoven string wordt geretourneerd via de functienaam zelf.

Dim StringLengthMin1 As Integer
Dim i As Integer
Dim k As Integer
Dim ch As String

HaalSpatiesWegUitWoord = inputstring
StringLengthMin1 = Len(HaalSpatiesWegUitWoord)
i = 1
zoekspatie:
k = i + 1                               'evt. spatie aan begin van woord wordt NIET verwijderd;
StringLengthMin1 = StringLengthMin1 - 1 'evt. spatie aan eind van woord wordt NIET verwijderd;
                                        'bij evt. 2 spaties naast elkaar wordt de tweede NIET verwijderd!
For i = k To StringLengthMin1 'I-loop: zoek tot het volgende hypen:
    ch = Mid$(HaalSpatiesWegUitWoord, i, 1)
    If ch = " " Then
        HaalSpatiesWegUitWoord = Left$(HaalSpatiesWegUitWoord, i - 1) & Right$(HaalSpatiesWegUitWoord, StringLengthMin1 + 1 - i)
        GoTo zoekspatie 'spring uit deze I-loop en begin aan een nieuwe voor de rest van de string
    End If
Next i

End Function
Function StringWithReplacedChar(inputstring As String, char As String, ipos As Integer) As String
StringWithReplacedChar = Left(inputstring, ipos - 1) & char & Right(inputstring, Len(inputstring) - ipos)
'Verandert 1 character in een string, op de letterpositie Ipos. Het resultaat wordt geretourneerd via de functienaam.
'Taalonafhankelijk en hoofdletteronafhankelijk. Als de inputvariabele char meer dan 1 teken bevat, worden bovendien
'letters toegevoegd aan de string; er vindt op evt. overschrijden van de lengte van de inputstring geen controle plaats.
End Function

Function LongStringWithReplacedChar(inputstring As String, char As String, ipos As Long) As String
LongStringWithReplacedChar = Left(inputstring, ipos - 1) & char & Right(inputstring, Len(inputstring) - ipos)
'Verandert 1 character in een string, op de letterpositie Ipos. Het resultaat wordt geretourneerd via de functienaam.
'Taalonafhankelijk en hoofdletteronafhankelijk. Als de inputvariabele char meer dan 1 teken bevat, worden bovendien
'letters toegevoegd aan de string; er vindt op evt. overschrijden van de lengte van de inputstring geen controle plaats.
End Function
Function KleineLetter(ch As String) As Boolean
'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim L As Integer
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 97 And L <= 122) Or (L >= 223 And L <= 255 And L <> 247) Or ((L >= 257 And L <= 383) And Not Even(L)) Then
KleineLetter = True
Else
KleineLetter = False
End If
End Function
Function GeheelUitHoofdletters(woord As String) As Boolean
'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim i As Integer
Dim ch As String
'kijkt of een woord dat met een hoofdletter begint, geheel uit hoofdletters bestaat:
GeheelUitHoofdletters = True
If Len(woord) = 1 Then GeheelUitHoofdletters = False  'bij 1-letter woord altijd: false
For i = 2 To Len(woord)
ch = Mid(woord, i, 1)
If Not Hoofdletter(ch) Then
    GeheelUitHoofdletters = False
    GoTo eind
End If
Next i
eind:
End Function
Function GeenKleineLetters(woord As String) As Boolean
'werkt als Function GeheelUitHoofdletters, maar laat naast Hoofdletters ook nog toe:
'           cijfers  ( 0 - 9 ) ,      bijv.  B3,   A15,   SOYUZ1,   PART028A    (geen cijfer op eerste positie!)
'           ingebedde hyphen,  bijv.  NRC-HANDELSBLAD  (geen hyphen of laatste positie!)
'           ingebedde apostrof, bijv.  O'CONNOR  (geen apostrof op laatste positie!)
Dim i As Integer
Dim ch As String
Dim LenWoord As String
'kijkt of een woord dat met een hoofdletter begint, in het geheel GEEN kleine letters bevat:
GeenKleineLetters = True
LenWoord = Len(woord)
If LenWoord = 1 Then GeenKleineLetters = False 'bij 1-letter woord altijd: false
For i = 2 To LenWoord
ch = Mid(woord, i, 1)
If Not Hoofdletter(ch) Then
    If Cijfer(ch) Then GoTo ok
    If i < LenWoord Then  '(want niet op laatste positie)
        If AscW(ch) = 45 Then GoTo ok      'hyphen
        If AscW(ch) = 8217 Then GoTo ok  'apostrof
        If AscW(ch) = 39 Then GoTo ok      'apostrof
        If AscW(ch) = 900 Then GoTo ok    'apostrof
        If AscW(ch) = 8242 Then GoTo ok  'apostrof
    End If
    GeenKleineLetters = False
    GoTo eind
End If
ok:
Next i
eind:
End Function
Function Cijfer(ch As String) As Boolean
Dim L As Integer
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 48 And L <= 57) Or (L >= 188 And L <= 190) Then
Cijfer = True
Else
Cijfer = False
End If
End Function
Function Even(i) As Boolean
'Dim i As Integer   'het is niet toegestaan een procedureparameter hier te declareren!
If (i Mod 2) = 0 Then
Even = True
Else
Even = False
End If
End Function
Function BeginHoofdletterTerug(inputstring As String) As String
'Van een inputstring met een kleine-letter-als-beginletter wordt
'een versie met beginhoofdletter teruggegeven via de functienaam zelf
'(alleen de beginletter verandert dus, de andere letters blijven ongewijzigd)

'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:
Dim L As Integer
Dim StringLength As Integer
Dim ch As String
StringLength = Len(inputstring)
ch = Left(inputstring, 1)    'beginletter
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 97 And L <= 122) Or (L >= 224 And L <= 253) Then   'kleine letter vervangen door hoofdletter
    L = L - 32
    BeginHoofdletterTerug = ChrW(L) & Right(inputstring, StringLength - 1)
ElseIf ((L >= 256 And L <= 375) And Not Even(L)) Or _
           ((L >= 377 And L <= 382) And Even(L)) Then
    L = L - 1
    BeginHoofdletterTerug = ChrW(L) & Right(inputstring, StringLength - 1)
Else
    BeginHoofdletterTerug = inputstring    '(geen kleine letter als beginletter aangetroffen)
End If
End Function
Function InStrSpatieEtc(nRand As Integer, inputstring As String) As Integer
'
'7 april 2004
'
'Deze macro kijkt WAAR in een string de EERSTE SPATIE
'of het eerste spatie-vervangend formateringsteken voorkomt
'(de commentaarregel onder "If Ascii" geeft aan welke tekens dit precies zijn).
'De betreffende positie wordt teruggemeld (nul indien er niets gevonden wordt).
'
'Met de parameter 'nRand' kan worden aangegeven hoeveel tekens
'aan het begin en aan het eind van de string buiten beschouwing mogen worden gelaten
'(bijv. gebruik  iRand=1  voor talen met 1-letterwoorden, maar  iRand=2  voor talen met
'minimaal tweeletterwoorden).
'Elk Unicode-teken (Esperanto of wat dan ook) mag in de string voorkomen.

Dim StringLength As Integer
Dim i As Integer
Dim Ascii As Integer
Dim ch As String

StringLength = Len(inputstring)
For i = nRand + 1 To StringLength - nRand
ch = Mid(inputstring, i, 1)
Ascii = AscW(ch)
If Ascii = 32 Or Ascii = 160 Or Ascii = 9 Or Ascii = 10 Or Ascii = 11 Or Ascii = 12 Or Ascii = 13 Or Ascii = 14 Then
'           spatie              spatie                tab          linefeed           linefeed       manual page break       CR     column break
    InStrSpatieEtc = i
    GoTo ready
End If
Next i
InStrSpatieEtc = 0
ready:
End Function

'*[ einde van de FUNCTIES VOOR STRING- EN CIJFER-verwerking die geshared zijn met VBA-Excel ]


Function AlleHoofdlettersWegUitString(inputstring As String) As String

'29 april 2005
'Van een inputstring (een of meerdere woorden lang) worden alle eventuele hoofdletters, inclusief de beginhoofdletter,
'omgezet naar kleine letters;   de veranderde versie wordt teruggegeven via de functienaam zelf.

'ook als de inputstring slechts ten dele uit hoofdletters bestaat, worden alle hoofdletters,  omgezet naar kleine letters;
'voorzover er in de inputstring reeds kleine letters zaten, blijven die gewoon staan.

'Geldt voor ASCII en de ASCII-extensies Latin-1 en Latin-Extended-A (<384),
'dwz voor UNICODE-Esperantoletters-geproduceerd-met-EK, en voor de meeste Europese talen,
'dus ook voor bijv. Franse en Duitse geaccentueerde letters:

Dim i As Integer
Dim L As Integer
Dim StringLength As Integer
Dim ch As String
StringLength = Len(inputstring)
AlleHoofdlettersWegUitString = inputstring
For i = 1 To StringLength
ch = Mid(inputstring, i, 1)    '2e (of 3e, 4e, etc) letter
L = AscW(ch)    'AscW (ASCII-WIDENED), voor code in UNICODE (Latin-1 en Latin-Extended A):
If (L >= 65 And L <= 90) Or (L >= 192 And L <= 221) Then   'hoofdletter vervangen door kleine letter
    L = L + 32
    AlleHoofdlettersWegUitString = Left(AlleHoofdlettersWegUitString, i - 1) & ChrW(L) & Right(AlleHoofdlettersWegUitString, StringLength - i)
ElseIf ((L >= 256 And L <= 375) And Even(L)) Or _
           ((L >= 377 And L <= 382) And Not Even(L)) Then
    L = L + 1
    AlleHoofdlettersWegUitString = Left(AlleHoofdlettersWegUitString, i - 1) & ChrW(L) & Right(AlleHoofdlettersWegUitString, StringLength - i)
End If
Next i
End Function

Function OveralVolgHoofdlettersWeg(Str As String) As String

'4 febr 2005
'converteert bijv.:   "MR. J.P. DE GRAAF en Associates"   in   "Mr. J.P. De Graaf en Associates"
Dim i As Integer
Dim j As Integer
Dim StrLen As Integer
Dim ch As String
Dim SaveStr As String

OveralVolgHoofdlettersWeg = Str  'default:  outputstring = inputstring
If Str = "" Then GoTo 90 'lege inputstring
SaveStr = Str   '(de inputstring moet onveranderd bewaard blijven voor het oproepende programma)
StrLen = Len(Str)
i = 1
10:
ch = Mid(Str, i, 1)    'het zoveelste teken van de String
If Hoofdletter(ch) Then
            j = 1
11:
            ch = Mid(Str, i + j, 1)
            If Hoofdletter(ch) Then
                    j = j + 1
                    If (i + j) <= StrLen Then GoTo 11
                    GoTo 12
            Else  'geen hoofdletter meer:
12:               If j > 1 Then     'rits met Volghoofdletters:
                    'subString van 2 of meer (om precies te zijn:  j ) aansluitende hoofdletters (beginnend op positie i in Str) gepasseerd
                    Str = Left(Str, i - 1) & VolgHoofdlettersWeg(Mid(Str, i, j)) & Right(Str, StrLen - (i + j - 1))
                    '(van de SubString zijn de VolgHoofdlettersWeg weggehaald)
                    i = i + j
                    Else
                    'eenzame hoofdletter (op positie i in Str) gepasseerd
                    End If
            End If
End If
i = i + 1
If i < StrLen Then GoTo 10

OveralVolgHoofdlettersWeg = Str
Str = SaveStr
90:
End Function


Function ExtractRitsMetVolgHoofdletters(Str As String, iMode As Integer) As String

'5 febr 2005
'converteert bijv.:   "Mr. J.P. De GRAAF en Associates"   in   "GRAAF"

'er zijn 3 modussen, afh. van de tweede inputparameter:
'
'iMode=0: alle ritsen met volghoofdletters worden teruggegeven, met spaties daar tussenin (bijv.  "Geert VAN DAM"  wordt  "VAN DAM" )
'iMode=1: alleen de EERSTE aangetroffen rits met volghoofdletters wordt teruggegeven  (bijv.  "Geert VAN DAM"  wordt  "VAN" )
'iMode=2: alleen de LAATSTE aangetroffen rits met volghoofdletters wordt teruggegeven (bijv.  "Geert VAN DAM"  wordt  "DAM" )
'[ onder een 'rits' wordt verstaan: een hoofdletter met volghoofdletters, dus minstens twee aaneengesloten hoofdletters (er mogen wel hyphens tussen de hoofdletters in staan) ]

Dim i As Integer
Dim j As Integer
Dim StrLen As Integer
Dim ch As String
ExtractRitsMetVolgHoofdletters = ""  'default:  lege string, wanneer geen rits met VolgHoofdletters
If Str = "" Then GoTo 90 'lege inputstring
StrLen = Len(Str)
i = 1
10:
ch = Mid(Str, i, 1)    'het zoveelste teken van de String
If Hoofdletter(ch) Then
            j = 1
11:
            ch = Mid(Str, i + j, 1)
            If Hoofdletter(ch) Or ch = "-" Then
                    j = j + 1
                    If (i + j) <= StrLen Then GoTo 11
                    GoTo 12
            Else  'geen hoofdletter meer:
12:               If j > 1 Then   'rits met Volghoofdletters:
                    'subString van 2 of meer (om precies te zijn:  j ) aansluitende hoofdletters (beginnend op positie i in Str) gepasseerd
                    If iMode = 0 Then ExtractRitsMetVolgHoofdletters = ExtractRitsMetVolgHoofdletters & " " & Mid(Str, i, j)
                    If iMode <> 0 Then ExtractRitsMetVolgHoofdletters = Mid(Str, i, j)
                    If iMode = 1 Then GoTo 90
                    If iMode <> 1 Then i = i + j
                    Else
                    'eenzame hoofdletter (op positie i in Str) gepasseerd
                    End If
            End If
End If
i = i + 1
If i < StrLen Then GoTo 10
90:
End Function

'ESPSOF Versio 0.8    15 Marto 2008 TW (Toon Witkam)


'===========================================================================================

'         1 6     S U B R U T I N O J      K A J      2     F U N K C I O J      P O R     L I T E R K O D -  K O N V E R T A D O

'===========================================================================================

'la subaj 18 proceduroj cxiuj rilatas al literkod-konvertado; kelkaj estas uzataj de la ESPSOF aplik-programoj, kaj multaj
'servas al preparo de tekstdosieroj fare de ESPSOF-uzantoj;
'ekzemple subrutino 'Supersignoj' konvertas chiujn '-h' kaj '-x' koditajn literojn al la veraj supersignitaj Esperanto-literoj
'(konforme al Unikodo kaj la EK-softvar de Jurij Finkel); ghi ankau konvertas 'au' kaj 'eu', sed ne 'EU';
'subrutino 'SupersignXstrict' konvertas nur  '-x' koditajn literojn, sed strikte, do ankau 'aux' kaj 'eux', sed ne 'au' kaj 'eu'.
'-----------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub Supersignoj()
'
' Supersignoj Macro
' Converts   cx,sx,gh,jh,  ch,sh,gx,jx,  hh,hx,  au, eu  (not EU).
'
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "cx"
        .Replacement.Text = ChrW(265)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sx"
        .Replacement.Text = ChrW(349)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gx"
        .Replacement.Text = ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "jx"
        .Replacement.Text = ChrW(309)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ch"
        .Replacement.Text = ChrW(265)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sh"
        .Replacement.Text = ChrW(349)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gh"
        .Replacement.Text = ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "jh"
        .Replacement.Text = ChrW(309)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "hh"
        .Replacement.Text = ChrW(293)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "hx"
        .Replacement.Text = ChrW(293)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "au"
        .Replacement.Text = "a" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "eu"
        .Replacement.Text = "e" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "E" & ChrW(364)
        .Replacement.Text = "EU"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub SupersignXstrict()
'
' SupersignXstrict Macro
' Converts   cx,sx, gx,jx,  hx,  aux, eux     (all in both upper and lower case).
'
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "cx"
        .Replacement.Text = ChrW(265)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sx"
        .Replacement.Text = ChrW(349)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gx"
        .Replacement.Text = ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "jx"
        .Replacement.Text = ChrW(309)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "hx"
        .Replacement.Text = ChrW(293)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "aux"
        .Replacement.Text = "a" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
        .Text = "eux"
        .Replacement.Text = "e" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    End Sub

Sub CharCodeNumberUNICODE()
'8 januari 2006 TW
Dim number As Integer
Dim UnicodeNumber As Long
number = AscW(Selection.Characters(1).Text)
If number >= 0 Then
    UnicodeNumber = number
Else
    UnicodeNumber = 65536 + number
End If
MsgBox "UnicodeNumber = " & UnicodeNumber

End Sub
Sub CharCodeNumberBASIC()
MsgBox "ASCII-BASIC number " & Asc(Selection.Characters(1).Text)
End Sub

Sub MacIntoshNaarUnicode()
'
' MacIntoshNaarUnicode Macro
' Macro recorded 4-2-03 by Toon Witkam
' Dit macro zet de Esperanto-teken codering van MacIntosh-files om in codering conform EK en Unicode.

' Kleine letters (5 stuks):

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(265)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(8710)
        .Replacement.Text = ChrW(309)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(349)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(729)
        .Replacement.Text = ChrW(293)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Hoofdletters (5 stuks):
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(264)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(284)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    'Selection.Find.ClearFormatting
    'Selection.Find.Replacement.ClearFormatting
    'With Selection.Find
     '   .Text = ?  *******MacIntosh kodo por la majuskla JX estas ankorau nekonata al mi******
     '   .Replacement.Text = ChrW(308)
     '   .Forward = True
     '   .Wrap = wdFindContinue
     '   .Format = False
     '   .MatchCase = True
    'End With
    'Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(348)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "�"
        .Replacement.Text = ChrW(292)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub Gdiacritic182()

'dit macro'tje is voor vervanging van ASCII/Unicode 182
'door Esperanto kleine letter g-met-diakritisch teken
'(deze codering is voorgekomen bij de aanlevering van een
'MacIntosh-schijf van de Esperanto Bibliotheek Wenen);
'het probleem bij code 182 is dat deze door de FIND/REPLACE
'van MS Word NIET geaccepteerd wordt (wschl door botsing met het
'echte paragraaf-teken, hoewel dat code 13 heeft)

' ATTENTIE:  zet zelf de cursor aan het begin van de file,
'            voor je het macro start

Dim nreplace As Integer

10:
Selection.Next(unit:=wdCharacter, Count:=1).Select
If AscW(Selection.Characters(1).Text) = 182 Then
    Selection.TypeText ChrW(285)
    nreplace = nreplace + 1
End If
If AscW(Selection.Characters(1).Text) = 165 Then GoTo 999

' ATTENTIE: plaats tevoren een YEN-teken (ASCII 165) aan EIND van file.
'           om zeker te zijn van een ordentelijke beeindigng
GoTo 10

999:
MsgBox "einde file bereikt " & Chr(13) & _
nreplace & " maal g-diakritisch geplaatst"

End Sub


Sub Krudaj()
'
' Krudaj Macro
' Converts  gi, ci, ce, cu, ec, sang, sat, sajn, ajo, ig (!), au, eu.
'
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "gi"
        .Replacement.Text = ChrW(285) & "i"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gin"
        .Replacement.Text = ChrW(285) & "in"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gia"
        .Replacement.Text = ChrW(285) & "ia"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "giaj"
        .Replacement.Text = ChrW(285) & "iaj"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "giajn"
        .Replacement.Text = ChrW(285) & "iajn"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gian"
        .Replacement.Text = ChrW(285) & "ian"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "gis"
        .Replacement.Text = ChrW(285) & "is"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ci-"
        .Replacement.Text = ChrW(265) & "i-"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ci"
        .Replacement.Text = ChrW(265) & "i"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ce"
        .Replacement.Text = ChrW(265) & "e"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "cu"
        .Replacement.Text = ChrW(265) & "u"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ec"
        .Replacement.Text = "e" & ChrW(265)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sang"
        .Replacement.Text = ChrW(349) & "an" & ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sajn"
        .Replacement.Text = ChrW(349) & "ajn"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "sat"
        .Replacement.Text = ChrW(349) & "at"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ajo"
        .Replacement.Text = "a" & ChrW(309) & "o"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "ig"
        .Replacement.Text = "i" & ChrW(285)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "au"
        .Replacement.Text = "a" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "eu"
        .Replacement.Text = "e" & ChrW(365)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "E" & ChrW(364)
        .Replacement.Text = "EU"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "gust"
        .Replacement.Text = ChrW(285) & "ust"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "jus"
        .Replacement.Text = ChrW(309) & "us"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "car"
        .Replacement.Text = ChrW(265) & "ar"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " ciu"
        .Replacement.Text = " " & ChrW(265) & "iu"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " cie"
        .Replacement.Text = " " & ChrW(265) & "ie"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " cia"
        .Replacement.Text = " " & ChrW(265) & "ia"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " cio"
        .Replacement.Text = " " & ChrW(265) & "io"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub


Sub TextConvertLatin3()   'voor het van Latin3 naar Esp (Unikodo) converteren van een hele tekst, zelfs een heel boek
'27-9-07
'Let op: je kunt beter een voor een elk hoofdstuk nemen, want bij verspringen van tekstformaat (koppen en zo) gaat het mis;
Dim TeConverterenText As String
TeConverterenText = Selection.Text   'JE MOET DUS WEL EERST DE TE CONVERTEREN TEKST SELECTEREN !
'MsgBox "TeConverterenText = " & Left(TeConverterenText, 20)   'testje [ook om er zeker van te zijn dat je op de goeie text-file zit]!
Selection.TypeText ConvertLatin3(TeConverterenText)
End Sub

Function ConvertLatin3(inputstring As String) As String
'Dit macro is bedoeld voor strings met evt. volgens Latin-3 (een verouderd systeem) gecodeerde Esperantoletters;
'het macro inspecteert de string en vervangt met Latin-3 codes (230,248,188,254,253 etc) gecodeerde Esperanto-dakjesletters
'door de (nieuwe en universele) Unicode Latin-Extended-A codes (264 en hoger), die daar speciaal en alleen voor Esperanto in
'zijn opgenomen. Deze Unicode-codering is ook die waarmee het software-pakket "EK" compatibel is.
'De aldus geconverteerde string wordt geretourneerd via de functienaam zelf.              Denk eraan dat dit macro
'een paar speciale letters en tekens (o.a. Scandinavische ae en het kwart-teken) altijd door Esp. letters zal vervangen .

Dim StringLength As Long
Dim i As Long
Dim L As Long
Dim ch As String

ConvertLatin3 = inputstring
StringLength = Len(inputstring)
If StringLength = 0 Then GoTo einde
For i = 1 To StringLength
ch = Mid(inputstring, i, 1)
L = AscW(ch)
If L > 255 Then GoTo nexti
Select Case L
Case 166: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(292), i)   '   �
Case 182: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(293), i)   '   �
Case 172: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(308), i)   '   �
Case 188: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(309), i)   '   �

Case 198: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(264), i)   '   �
Case 230: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(265), i)   '   �
Case 216: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(284), i)   '   �
Case 248: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(285), i)   '   �

Case 221: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(364), i)   '   �
Case 253: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(365), i)   '   �
Case 222: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(348), i)   '   �
Case 254: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(349), i)   '   �

Case 240: ConvertLatin3 = LongStringWithReplacedChar(ConvertLatin3, ChrW(293), i)   '   �    'ontdekt en toegevoegd 29-9-07

End Select
nexti: Next i
einde:
End Function
Sub Latin4()

' 8 febr 2004 (op 11 januari 2005 bovendien de coderingen van � en van � toegevoegd).

' Converteert  bizarre codering Esp.dakjesletters in Monde-Diplomatique tekstfiles afkomstig uit Lycos webpages
' van Vilhelmo Lutermano, naar dakjesletters volgens Unicode;
' converteert ook bizarre openings- en sluit-aanhalingstekens naar meer normale.aanhalingstekens.

'dit macro converteert geen � anders dan na a, e, A of E [zie het macro 'Latin4voorPIVetc']

    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(196) & ChrW(8240)      'ĉ
        .Replacement.Text = ChrW(265)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(157)       'ĝ
        .Replacement.Text = ChrW(285)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(165)       'ĥ
        .Replacement.Text = ChrW(293)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(181)       'ĵ
        .Replacement.Text = ChrW(309)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(157)       'ŝ
        .Replacement.Text = ChrW(349)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "a" & ChrW(197)                                 'a�
        .Replacement.Text = "a" & ChrW(365)   'a�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "A" & ChrW(197)                                 'A�
        .Replacement.Text = "A" & ChrW(365)   'A�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "e" & ChrW(197)                                 'e�
        .Replacement.Text = "e" & ChrW(365)   'e�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "E" & ChrW(197)                                 'E�
        .Replacement.Text = "E" & ChrW(365)   'E�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll

'Hoofdletters:
    With Selection.Find
        .Text = ChrW(196) & ChrW(710)       'Ĉ
        .Replacement.Text = ChrW(264)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(339)      'Ĝ
        .Replacement.Text = ChrW(284)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(164)       'Ĥ
        .Replacement.Text = ChrW(292)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(180)      'Ĵ
        .Replacement.Text = ChrW(308)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(339)       'Ŝ
        .Replacement.Text = ChrW(348)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(31)         '� gevolgd door optional hyphen
        .Replacement.Text = ChrW(364)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll

'Aanhalingstekens:
    With Selection.Find
        .Text = ChrW(226) & ChrW(8364) & ChrW(339)      'openings-aanhalingstekens
        .Replacement.Text = ChrW(34)   '    "   [het gewone ASCII aanhalinsgteken]
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(226) & ChrW(8364) & ChrW(157)        'sluit-aanhalingstekens
        .Replacement.Text = ChrW(34)   '    "   [het gewone ASCII aanhalinsgteken]
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(226) & ChrW(8364) & ChrW(8220)
        .Replacement.Text = ChrW(150)   'lange gedachtenstreep
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(226) & ChrW(8364) & ChrW(166)
        .Replacement.Text = ChrW(150)   '3 puntjes
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub
Sub Latin4voorPIVetc()
'
' 25 januari 2005;   dit macro is speciaal geschikt voor conversie van woordenboeken (PIV) of woordenlijsten;
' anders dan het gewone Latin4-conversie-macro,  converteert dit macro � los van enige voorgaande klinker;
'dit macro houdt dus houdt niet alleen rekening met � in de combinaties a� en e�, maar ook in o�, in onomatopeen (k�aks) of eigennamen (G�angdongo).

' dit macro is gebruikt voor de omcodering van PIVKAP-Grimley-Evans, naar dakjesletters volgens Unicode;
' het converteert GEEN openings- en sluit-aanhalingstekens;
'de Scandinavische hoofdletter � wordt door deze conversieroutine ALTIJD omgezet naar de Esperantoletter �.
    
    Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(196) & ChrW(8240)      'ĉ
        .Replacement.Text = ChrW(265)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(157)       'ĝ
        .Replacement.Text = ChrW(285)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(165)       'ĥ
        .Replacement.Text = ChrW(293)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(181)       'ĵ
        .Replacement.Text = ChrW(309)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(157)       'ŝ
        .Replacement.Text = ChrW(349)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197)                                '�
        .Replacement.Text = ChrW(365)   '�                  'Attentie: het is voorgekomen dat onder invloed van een voorafgaande hoofdletter...
        .Forward = True                                                 '...(in een geval als G�angdongo) er niet een � maar � werd ingezet G�angdongo); ...
        .Wrap = wdFindContinue                                   '... manuele controle achteraf daarom aanbevolen!
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll


'Hoofdletters:
    With Selection.Find
        .Text = ChrW(196) & ChrW(710)       'Ĉ
        .Replacement.Text = ChrW(264)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(339)      'Ĝ
        .Replacement.Text = ChrW(284)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(164)       'Ĥ
        .Replacement.Text = ChrW(292)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(196) & ChrW(180)      'Ĵ
        .Replacement.Text = ChrW(308)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(339)       'Ŝ
        .Replacement.Text = ChrW(348)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(197) & ChrW(31)         '� gevolgd door optional hyphen
        .Replacement.Text = ChrW(364)   '�
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub
Sub BackConversionSupersignoj()
'
' Macro recorded 30-Jul-04 by  TW
' Dit macro converteert de Esperanto-dakjesletters �, �, �, �, �, � naar cx, gx, hx, jx, sx, ux
' voor het verzenden van files naar ontvangers (bijv. MacIntosh-gebruikers) die geen Unicode kunnen verwerken;
' ook de hoofdletters �, � etc worden geconverteerd (naar CX, GX etc).

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(265)
        .Replacement.Text = "cx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(285)
        .Replacement.Text = "gx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(293)
        .Replacement.Text = "hx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(309)
        .Replacement.Text = "jx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(349)
        .Replacement.Text = "sx"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(365)
        .Replacement.Text = "ux"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(264)
        .Replacement.Text = "CX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(284)
        .Replacement.Text = "GX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(292)
        .Replacement.Text = "HX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(308)
        .Replacement.Text = "JX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(348)
        .Replacement.Text = "SX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ChrW(364)
        .Replacement.Text = "UX"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub Transitivering()
'
' Transitivering Macro
' Converts  intransitive to transitive ig (-ending),
' "&chr(10)&"only 1 occurence at a time, by pressing END-key

    Dim wdFindOne As Long
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "i" & ChrW(285)  ' = "i�"
        .Replacement.Text = "ig"
        .Forward = True
        .Wrap = wdFindOne
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceOne
End Sub
Sub AllForeignCharacters()

Dim n As Integer
Dim j As Integer
Dim i As Integer
Dim ch As String

For j = 2 To 16
Selection.Next(unit:=wdLine, Count:=2).Select
n = (j - 1) * 32

For i = n To n + 31
ch = ChrW(i)
Selection.TypeText Text:=ch & "  "
Selection.Collapse direction:=wdCollapseEnd
Next i

Next j

End Sub
Sub UnicodeVriendelijkeConversie()
 Dim TekstWoord As String
 Dim HulpString As String
 Dim iLijstWoord As Integer
 Dim Lengte As Integer
 Dim ChBegin As String
 Dim UnicodeValue As Integer
 
        'TekstWoord = LCase(TekstWoord)                 'conversie naar Lowercase mag geen Unicode...
        HulpString = StrConv(TekstWoord, vbUnicode)     '...(Esp. letters met diakr.tekens) verstoren,
        HulpString = StrConv(HulpString, vbLowerCase)   'daarom dit drieregelig alternatief
        TekstWoord = StrConv(HulpString, vbFromUnicode) 'in plaats van de LCase functie!

GoTo 99

'maar hoewel bovenstaande 3--regelige conversie geen Unicode kapotmaakt (zoals LCase),
'bleek de conversie van Unicode letters ZELF (C-dakje, G-dakje, U-boogje etc.)...
'...naar de corresponderende kleine letters (c-dakje, g-dakje, u-boogje etc.) er NIET door...
'...geefeectueerd te worden; daarvoor is onderstaande code nodig:

'(code-voorbeeld, ontleend aan macro AZMenWoordFrequentie):
ActiveDocument.Tables(1).Cell(iLijstWoord, 1).Select
HulpString = Selection.Text
Lengte = Len(HulpString)  'N.B. achter elk woord in een Table-cell zitten 2 formatteringstekens geplakt:
HulpString = Left(HulpString, Lengte - 2)  'formatteringstekens weglaten (die leiden tot verstoringen);
HulpString = StrConv(HulpString, vbUnicode)     'om Unicode Esperanto letters met diakr.tekens...
HulpString = StrConv(HulpString, vbLowerCase)   '...niet te verstoren, dit drieregelig alternatief...
HulpString = StrConv(HulpString, vbFromUnicode) '...in plaats van de simpele LCase functie!
ChBegin = Left(HulpString, 1)
UnicodeValue = AscW(ChBegin)
MsgBox "UnicodeValue = " & UnicodeValue
If Hoofdletter(ChBegin) = True Then
    MsgBox "nog steeds hoofdletter"     'speciale eigenschap bij codes Unicode karakters:
    ChBegin = ChrW(AscW(ChBegin) + 1)   'conversie hoofdletter -> kleine letter door 1 erbij op te tellen
    End If                              'Let op gebruik ChrW en AscW functies voor Unicode !
Selection.TypeText ChBegin & Right(HulpString, Len(HulpString) - 1) 'concatenate with lower case begin letter
UnicodeValue = AscW(ChBegin)
MsgBox "UnicodeValue = " & UnicodeValue


    
    'WoordCell.Range.Text = LCase(WstatLijstWoord(iLijstWoord))      'conversie naar Lowercase mag geen Unicode
    'HulpString = StrConv(WstatLijstWoord(iLijstWoord), vbUnicode)    '(Esp. letters met diakr.tekens) verstoren,
    'HulpString = StrConv(HulpString, vbLowerCase)               'daarom dit drieregelig alternatief
    'WoordCell.Range.Text = StrConv(HulpString, vbFromUnicode)   'in plaats van de LCase functie!



99:
End Sub

Function EspDakjesWeg(inputstring As String) As String
'Deze macro is bedoeld voor UNICODE-Esperantoletters (zoals geproduceerd met o.a. het Esperanto-softwarepakket "EK").
'Van een inputstring in Esperanto, met evt. dakjesletters (diakritisch teken op de c, g, h, j, s of u)
'worden de dakjes verwijderd. De letters die eerst onder de dakjes stonden blijven staan.
'De aldus gewijzigde string wordt geretourneerd via de functienaam zelf.

'Het weghalen van dakjes geldt ALLEEN voor de 6 genoemde Esperanto-letters
'(en geldt overigens OOK voor de 6 hoofdlettervarianten van deze Esperanto-letters).
'Dakjes en/of accenten van letters uit andere talen (Frans, Duits etc) worden NIET weggehaald!

Dim StringLength As Integer
Dim i As Integer
Dim L As Integer
Dim ch As String

EspDakjesWeg = inputstring
StringLength = Len(inputstring)
If StringLength = 0 Then GoTo einde
For i = 1 To StringLength
ch = Mid(inputstring, i, 1)
L = AscW(ch)
If L < 264 Then GoTo nexti
Select Case L
Case 264: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "C", i)
Case 265: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "c", i)
Case 284: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "G", i)
Case 285: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "g", i)
Case 292: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "H", i)
Case 293: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "h", i)
Case 308: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "J", i)
Case 309: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "j", i)
Case 348: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "S", i)
Case 349: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "s", i)
Case 364: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "U", i)
Case 365: EspDakjesWeg = StringWithReplacedChar(EspDakjesWeg, "u", i)
End Select
nexti: Next i
einde:
End Function

Sub VreemdeTekensSpecifyAndFind()

'dit macro werd geinspireerd door de onzekerheid over het FIND-able maken van
'lange gedachtenstrepen; in eerdere tests leverde dit nogal wat ongedetermineerdheid op;
'dmv dit macro werd eerst uitgevonden (in de For i -loop) WAT de interne (ASCII of ANSI- code)
'van een (door een of andere onbekende autocorrectie gegenereerde) lange gedachtenstreep is:

Dim i As Integer
Dim char As String
Dim icode As Integer

For i = 1 To 20
ActiveDocument.Characters(i).Select
char = Selection.Text
icode = Asc(char)
MsgBox char & " = " & icode
Next i

'vervolgens werd onderstaand stuk code toegevoegd, om te checken of de FIND
'met de opgegeven ANSI-waarde inderdaad de lange gedachtenstreep terug vindt:

Selection.Collapse
Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:=""

Selection.Find.ClearFormatting
    'de verkorte vorm Selection.Find.Execute(string) levert soms 'Error 5692' op!
    With Selection.Find
        .Text = Chr(150)   ' ANSI 150 is de lange gedachtenstreep
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found = True Then MsgBox "gevonden!"


99:
End Sub

Sub RemoveAlleMordisTekens()

' Macro recorded 26-1-08 by  TW
' Dit macro verwijdert alle MORDIS-tekens (Unicode 65123 en/of 183) uit de tekstfile
    
    MsgBox "dit macro verwijdert alle MORDIS-tekens uit de tekstfile"
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(65123)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ChrW(183)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
        .MatchFuzzy = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

End Sub