Attribute VB_Name = "EspKONTR" 'EspKONTR 'ESPSOF Versio 0.95 Makroo-Modjulo uzebla de MS WORD 'ESPSOF Versio 0.95 '31-01-09 (een aantal MsgBoxen bij fouten tijdens SVO-analyse zijn hierin afgeklemd door tijdelijke toevoeging van commentaar-apostrof) '30-01-09 (met MsgBoxen bij fouten tijdens SVO-analyse) 'ESPSOF Versio 0.95 30 januaro 2009 TW (Toon Witkam) '[antaŭa nomo: EspTextAnalyzer] 'tiu chi modjulo entenas 19 procedurojn: 11 subrutinojn kaj 8 funkciojn; 'la subrutino 'TEKSTanal' (antaua nomo 'EspTekstAnalizilo') rolas kiel chefa programo: 'en tiu chi modjulo ghi estas la sola programo direkte alvokebla el MS WORD; 'la aliaj proceduroj estas ĉiuj subordigitaj. Option Explicit Public CalledByTekstAnal As Boolean '[10-3-2008; dient voor communicatie met EspWSTAT.AFMbazo]; Public statusEnigoTEKSTanal As Integer '[1-5-2008] Public EspsofExcel As Object '[10-5-2008] Public EspsofREGREZ As String '[7-5-2008] 'krijgt door macro TEKSTanal de precieze REGREZ-filenaam toegewezen Public TekstoKajNotojAparte As Boolean '[27-12-2008] Public FootnotesBeingProcessed As Boolean '[27-12-2008] Public EndnotesBeingProcessed As Boolean '[27-12-2008] Public iNummer1eAlinea As Integer '[3-6-2008] Public nAantalAlineas As Integer '[5-1-09] ivm aparte oproepen van AFMbazo, maar met doortelling Alineanummers bij wisseling MainText, Footnotes, Endnotes Public iBasis1eAlinea As Integer '[6-1-09] ivm nAantalAlineas Public ibeepfreq As Integer Public Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency As Long, ByVal dwMilliseconds As Long) As Long '[25-9-08] 'PRIVATE statische variabelen dienen alleen voor communicatie BINNEN de module EspKONTR: Private EspsofVORTAR As String '[6-5-2008] 'krijgt door macro TEKSTanal de precieze VORTAR-filenaam toegewezen Private CurrentBronTekstFilenaam As String '[11-2-2008] Private IncrementRezultTekstFilenaam As Integer '[11-2-2008] Private ZinBegintMetHaltoStreko As Boolean '[24-5-2008] Private PreviousTekstWoord As String '[12-4-2008] Private ScanProblemIl As Boolean '[12-4-2008] 'laatste twee tekens van variable-naam: hoofdletter i gevolgd door kleine letter l Private ScanProblem1l As Boolean '[12-4-2008] 'laatste twee tekens van variable-naam: cijfer 1 gevolgd door kleine letter l Private ScanProblemCC As Boolean '[12-4-2008] 'slaat op door scanner gelezen C in plaats van Ĉ Private ScanProblemSS As Boolean '[12-4-2008] 'slaat op door scanner gelezen S in plaats van Ŝ Private ScanProblemjj As Boolean '[12-4-2008] 'slaat op door scanner gelezen j in plaats van ĵ Private ScanProblemrnm As Boolean '[13-5-2008] 'slaat op door scanner gelezen r n in plaats van m Private ScanProblemmrn As Boolean '[13-5-2008] 'slaat op door scanner gelezen m in plaats van r n Private ArkaikCiAkceptu As Boolean '[12-5-2008] Private StreketoEnNombrGhis100 As Boolean '[9-7-2008] Private iKglobal As Long Private nPositiveDictSearches As Long Private nNegativeDictSearches As Long Private WstatWordtoExcel As Object '[26-5-2008] Private JustFinishedTekstKontrol As Boolean Private MorDisWasThere As Boolean Private Const MorDis As Integer = 183 'Unicode 183 ('puntje' op midden-letterhoogte) geeft geen character-spacing problemen, i.t.t. Unicode 65123 Private MorDisVariant As Integer Private CxiujnWasThere As Boolean '[15-6-08] Private UnuVortIsOn As Boolean '[15-6-08] Private iPosCursorFontoTeksto As Long '[16-6-08] Private nMorDisInWoord As Integer '[19-6-08] Private BROonly As Boolean '[1-8-08] Private BROkunmetDeel As Boolean '[27-8-08] Private GenVoc16only As Boolean '[1-8-08] Private TutaPIV As Boolean '[1-8-08] Private AnkauDict3 As Boolean '[2-8-08] Private AnkauPrivatVortaro As Boolean '[2-8-08] Sub MontruMorDisEnVorto() '3 junio 2008 ' MONTRU (uzu Alt+M) Dim TekstWoord As String Dim MorfeemStruct As String Dim MeerDanEen As Boolean UnuVortIsOn = True '18-6-08 If MorDisWasThere Then 'voor het afwisselend aan- en uitklikken van de Morfeemstructuur van 1 woord [15-6-08] , ... If Selection.Characters(1).Start = iPosCursorFontoTeksto - nMorDisInWoord Then ' ...mits de Cursor nog achter datzelfde woord staat [19-6-08] ActiveDocument.Undo 1 MorDisWasThere = False 'de switch 'MorDisWasThere' (tussen de 2 macros) verhindert dat drukken op knop Montru kan leiden tot andere Undo's [15-11-06] GoTo 900 End If End If 'Maak aanklikken van een woord mogelijk '(ook het evt. daarbij verschijnen van een pop-up menu), 'en bepaal welk woord de gebruiker heeft aangeklikt: 10: TekstWoord = Selection.Text If Left(TekstWoord, 1) = " " Then 'hou rekening met evt.leading en/of trailing space rond het geselecteerde woord Selection.MoveStart Count:=1 End If If Right(TekstWoord, 1) = " " Then Selection.MoveEnd Count:=-1 End If TekstWoord = Selection.Text If Len(TekstWoord) <= 1 Then '[dit stmt is betrouwbaarder dan: If TekstWoord = "" ] MsgBox "selektu tekstvorton" ' "select a textword" GoTo 900 ElseIf Len(TekstWoord) < 2 Then MsgBox "selektu tekstvorton kun almenau 2 literoj" ' "select a word of at least 2 letters" GoTo 900 ElseIf InStr(2, TekstWoord, ChrW(MorDis)) > 0 Then MsgBox "NE selektu tekstvorton kiu jam enhavas morfemdisigilojn" GoTo 900 ElseIf InStr(1, TekstWoord, " ") > 0 Then MsgBox "selektu nur unu tekstvorton" GoTo 900 End If MorDisVariant = 1 If Not SercxuMorDisEnVorto(TekstWoord, MorfeemStruct, MeerDanEen, MorDisVariant) Then If TekstWoord = "" Then GoTo 900 '(if SercxuMorDisEnVorto was abandonned because WstatWordToExcel was not set) [19-6-08] MsgBox "la tekstvorto ne estas en la listo de kontrolitaj vortoj ;" & vbCr & _ "eble vi selektis grizan vorton, transsaltitan dum la tekstanalizo ?" & vbCr & vbCr & _ "denove selektu (plenan) vorton; ne selektu vortparton au cifervorton " 'MsgBox "tekstwoord komt niet in TaalwoordLijst of EigennaamLijst voor" & vbCr & vbCr & _ ' "hebt u misschien een oversprongen woord, een cijferwoord of leestekenwoord geselecteerd?" & vbCr & _ ' "selecteer dan een echt tekstwoord!" GoTo 900 Else If MorfeemStruct = "" Then Selection.Collapse direction:=wdCollapseEnd '(bij niet-geassimileerde Eigennamen ontbreekt een morfeemstructuur) nMorDisInWoord = 0 '[19-6-08] Else 'If MorfeemStruct <> "" Then: nMorDisInWoord = Len(MorfeemStruct) - Len(TekstWoord) 'nodig ivm variatie in iPosCursorFontoTeksto [19-6-08] If MeerDanEen Then Selection.Font.Underline = wdUnderlineDotted 'een woord waarvoor MEERDERE Structs gevonden zijn... Selection.Font.UnderlineColor = wdColorAutomatic '...wordt ONDERSTIPPELD End If 'Vervang het aangeklikte woord door zijn morfeem-structuur 'en reproduceer daarbij een evt. beginhoofdletter van het tekstwoord (bij Unmarked Cap of bij Eigennaam): If Hoofdletter(Left(TekstWoord, 1)) Then MorfeemStruct = BeginHoofdletterTerug(MorfeemStruct) '[26-5-08] Selection.TypeText MorfeemStruct iPosCursorFontoTeksto = Selection.Characters(1).Start 'cursorpositie achter dit woord opslaan ... End If ' ... ivm check bij evt. hierop volgend Kashu (Alt+K) ... End If ' ... en daar evt. weer opnieuw opvolgend Montru (Alt+M) JustFinishedTekstKontrol = False '[18-6-08] 900: End Sub Sub VariiguMorDisEnVorto() '28 julio 2008 ' VARIIGU (uzu Alt+V) Dim TekstWoord As String Dim iPosNextMorDis As Integer Dim nPos As Integer Dim LinkerDeel As String Dim RechterDeel As String Dim MorfeemStruct As String Dim MeerDanEen As Boolean 'Aanklikken van een woord dat reeds morfeemgesplitst is en met gestippelde onderstreping op het scherm staat, 'om een variant van de meerdere morfeemsplitsingen te laten zien: 10: TekstWoord = Selection.Text '-------28-7-08-----: If Left(TekstWoord, 1) = " " Then 'hou rekening met evt.leading en/of trailing space rond het geselecteerde woord Selection.MoveStart Count:=1 End If If Right(TekstWoord, 1) = " " Then Selection.MoveEnd Count:=-1 End If TekstWoord = Selection.Text If Len(TekstWoord) <= 1 Then '[dit stmt is betrouwbaarder dan: If TekstWoord = "" ] MsgBox "selektu tekstvorton" ' "select a textword" GoTo 900 End If '---- If Not (InStr(2, TekstWoord, ChrW(MorDis)) > 0 And _ Selection.Font.Underline = wdUnderlineDotted And _ Selection.Font.UnderlineColor = wdColorAutomatic) Then MsgBox "variigi morfemstrukturon nur eblas che vorto " & vbCr & _ "kies morfemstrukturo jam videblas " & vbCr & _ "kaj kiu havas punktitan substreko " & vbCr & vbCr & _ "selektu tian vorton" GoTo 900 End If 'Om te kunnen fungeren als snelle zoek-key in SercxuMorDisEnVorto moeten .... ' ...nu eerst de MorDis-tekens uit het TekstWoord worden verwijderd: iPosNextMorDis = 2 '(zodat in het TekstWoord pas vanaf positie 3 naar een MorDis-teken gezocht wordt [zie Instr-aanroep hieronder]) 4: iPosNextMorDis = InStr(iPosNextMorDis + 1, TekstWoord, ChrW(MorDis)) If iPosNextMorDis = 0 Then GoTo 5 LinkerDeel = Left(TekstWoord, iPosNextMorDis - 1) 'deel links van aangetroffen MorDis-teken RechterDeel = Right(TekstWoord, Len(TekstWoord) - iPosNextMorDis) 'deel rechts van aangetroffen MorDis-teken TekstWoord = LinkerDeel & RechterDeel 'aangetroffen MorDis-teken verwijderd uit TekstWoord nPos = nPos + 1 'iteratie-teller If nPos > 16 Then MsgBox "pli ol 16 morfemlimoj en vorto; vershajne iu eraro": GoTo 900 GoTo 4 5: If nPos = 0 Then MsgBox "Error: geen enkel MorDis-teken gevonden in TekstWoord": GoTo 900 'alle MorDis-tekens nu verwijderd uit TekstWoord MorDisVariant = MorDisVariant + 1 If MorDisVariant = 5 Then MorDisVariant = 1 If SercxuMorDisEnVorto(TekstWoord, MorfeemStruct, MeerDanEen, MorDisVariant) Then 'Vervang het aangeklikte woord door de morfeem-struct 'en reproduceer daarbij een evt. beginhoofdletter van het tekstwoord (bij Unmarked Cap of bij Eigennaam): If MorfeemStruct <> "" Then If Hoofdletter(Left(TekstWoord, 1)) Then MorfeemStruct = BeginHoofdletterTerug(MorfeemStruct) '[26-5-08] End If Selection.TypeText MorfeemStruct If MorDisVariant <> 1 Then Selection.MoveStart Count:=-Len(MorfeemStruct) 'bij Alternatieven de (MS WORD-) SELECTIE laten staan [16-6-08] Else MsgBox "Error: woord met deze morfeemstructuur niet meer teruggevonden in ESPSOF-REGREZ" GoTo 900 End If 900: End Sub Function SercxuMorDisEnVorto(TekstWoord As String, MorfeemStruct As String, Alternativoj As Boolean, MorDisVarNumb As Integer) As Boolean '27-1-09 '4 junio 2008 TW (Toon Witkam) [antaua nomo: AlklakuVorton ] 'interne snelzoek-functie ten dienste van zowel MontruMorDisEnVorto als Variigu MorDisEnVorto Dim iLijstWoord As Long Dim iLijstWstatn As Integer Dim WstatnLijstWoord As Long Dim WstatnTaalWoord As Long Dim WstatnLijstEigennaam As Integer Dim WstatnEigennaam As Integer 'Dim TekstWoord As String Dim key As String Dim lijstwoord As String Dim low As Long Dim high As Long Dim middle As Long Dim MatchPos As Long Dim KritCharPos(2, 25) As Integer Dim iKritChar As Integer Dim nKritChar As Integer Dim iChar As Integer Dim k As Integer Dim Nulvector As Boolean Dim matchBinary As Boolean Dim LenWoord As Integer Dim KorG As Integer Dim i1 As Long Dim Iend As Long Dim i1Eigennaam As Long Dim IendEigennaam As Long Dim MetEigennaamBezig As Boolean Dim Wsh As Integer Dim Structkolom As Integer 'Dim MorfeemStruct As String 'Private WstatWordtoExcel As Object [zie bovenaan Module] [26-5-08] 'aansluitend op eerder gebruik van TEKSTanal en de daardoor achtergelaten en (bij MiMemPretigu) nog geopende resultaatsfile REGREZ ... ' ...of de (bij PretiguAutomate) door SaveCopyAs in een Excel-file met Brontekstnaam opgeslagen inhoud van de inmiddels schoongeveegde REGREZ [4-6-08]: With WstatWordtoExcel i1 = 2 i1Eigennaam = 2 Wsh = 1 'kijk lijstlengtes na in Worksheet1 (Resumo van ESPSOF-REGREZ): On Error Resume Next '[19-6-08] Iend = .worksheets(Wsh).Cells(22, 4).Value + i1 - 1 If Err.number = 91 Then '[19-6-08] MsgBox "nur TUJ post pritrakto de TEKSTanal " & vbCr & _ " tiu chi komando eblas" Err.Clear TekstWoord = "" 'to signal macro that called SercxuMorDisEnVorto to resign from further action or messages [19-6-08] GoTo 900 End If IendEigennaam = .worksheets(Wsh).Cells(23, 4).Value + i1Eigennaam - 1 'Zowel bij Taalwoordlijst als Eigennaamlijst staat de MorfeemStruct in kolom 9, 'althans de default of eerste morfeemstructuur; rekening houdend met max. 4 varianten (incl. de default); If MorDisVarNumb > 4 Then MsgBox "Error in Telling Morfeemstructuur-Varianten" Structkolom = 9 - 1 + MorDisVarNumb 'evt. varianten dus in kolom 10, 11, 12 Wsh = 2 'TaalwoordLijst staat in Worksheet 2 MetEigennaamBezig = False 'zoek eerst op TaalWoord (als default) 'Zoek TekstWoord op in een van de tekst-Woordlijsten (in eerste instantie in de tekst-TaalwoordLijst, in tweede instantie in... '...de tekst-EigennaamLijst), en haal daaruit de morfeemstructuur op: '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------- GoTo 70000 'QUASI-SUBROUTINE voor (Snelheidsverhogend) BINAIR ZOEK-proces in de tekst-Lijsten: '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'bij een Match in tekst-TaalwoordenLijst of tekst-EigennaamLijst wordt naar label 800 gesprongen; 'bij GEEN Match naar label 700. '++++++QUASI-SUBROUTINE+++++ (Snelheidsverhogend) BINAIR ZOEK- proces +++++(zonder inserties)++++++[5-4-2008]: 70000: 'Ingang TAALWOORDEN (tekst-TaalwoordLijst) '[Eigennamen gaan via ingang 70001 ] 'MATCH- en INSERT-proces: '[29-11-05} hieronder is alles overgenomen uit het macro 'MatchEnkelEspWordToDictionary' [labels geprefigeerd met 77], 'behalve het key-naar-keynh reductie; in het tekst-Woordlijst-stadium willen we NIET met ... ' ... weggehaalde hyphens opereren, maar juist de hyphens laten staan, om onderscheid te maken tussen ' ... tekstwoorden met en zonder hyphen (denk aan konkludo vs. konk-ludo). key = TekstWoord If Hoofdletter(Left(key, 1)) Then key = BeginHoofdletterWeg(key) 'evt. beginhoofdletter wordt weggehaald low = i1 ' i1 = Begin van tekst-WoordLijst high = Iend 'Iend = Einde van tekst-WoordLijst MatchPos = 0 'Op de tekst-TaalwoordLijst is de ESP-DICT-SORTERING (ipv Excel-sortering) van toepassing: iKritChar = 1 For iChar = 1 To Len(key) 'Vector van Kritische Character-Posities wordt opgesteld: k = AscW(Mid(key, iChar, 1)) If k = 99 Then KritCharPos(2, iKritChar) = 265: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 103 Then: KritCharPos(2, iKritChar) = 285: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 104 Then: KritCharPos(2, iKritChar) = 293: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 106 Then: KritCharPos(2, iKritChar) = 309: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 115 Then: KritCharPos(2, iKritChar) = 349: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 117 Then: KritCharPos(2, iKritChar) = 365: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If If Not k > 122 Then GoTo 70010 If k = 265 Then KritCharPos(2, iKritChar) = 99: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 285 Then: KritCharPos(2, iKritChar) = 103: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 293 Then: KritCharPos(2, iKritChar) = 104: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 309 Then: KritCharPos(2, iKritChar) = 106: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 349 Then: KritCharPos(2, iKritChar) = 115: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 365 Then: KritCharPos(2, iKritChar) = 117: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If 70010: '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) Next iChar nKritChar = iKritChar - 1 'nKritChar = aantal kritische characterposities in zoekwoord, namelijk die... '...waarop een 'kritisch character' staat: c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ; 'De Kritische-Character-Positie-Vector heeft nKritChar kolommen van elk 2 integerwaarden: 'de eerste geeft de letterpositie in het woord aan, 'de tweede geeft het Unicode-nummer van het Complementaire Teken aan (waarbij bijv. s complementair is met ŝ ) 'indien nKritChar=0 dan heeft het zoekwoord een 'Nulvector' (geen kritische tekens, bijv. 'tablo', 'prezidento', ...): If nKritChar = 0 Then Nulvector = True Else Nulvector = False GoTo 77100 ' ----------------------- 70001: 'ingang EIGENNAMEN (tekst-EigennaamLijst) '[Taalwoorden gaan via ingang 70000 ] key = TekstWoord 'evt. beginhoofdletter blijft behouden low = i1Eigennaam ' i1Eigennaam = Begin van EigennaamLijst high = IendEigennaam 'IendEigennaam = Einde van EigennaamLijst MatchPos = 0 'Op de tekst-EigennaamLijst is de gewone Excel-sortering van toepassing. Nulvector = True '[28-1-2008] '---------------------------------------------------- op basis van Binary Search algorithme [see Tanenbaum, p. 305-307]: ---------------------------------------------------------------------- 77100: 77101: If low = high Then 'Zoekrange geheel ingezoomd (nu Matchen of Inserten): middle = low If key = .worksheets(Wsh).Cells(low, 2).Value Then 'Match: MatchPos = middle 'MsgBox "match! TaalWoordLijst- of EigennaamLijst-positie = " & MatchPos GoTo 77700 Else GoTo 700 'Uitgang bij GEEN Match End If ElseIf low < high Then middle = (low + high) / 2 'Deel zoekrange op in twee helften (afronding middenpositie soms naar boven soms naar beneden): 77250: lijstwoord = .worksheets(Wsh).Cells(middle, 2).Value If MetEigennaamBezig Then 'de Eigennaamlijst wordt volgens GEWONE alfabetische SORTERING opgebouwd (NIET volgens speciale Esp-dict sortering) KorG = StrComp(key, lijstwoord, vbTextCompare) 'hierbij komt bijv. "Ĉinio" VOOR "Cezaro" te staan in de Eigennaamlijst 'KorG = StrComp(key, lijstwoord, vbBinaryCompare) '[hierbij zou bijv. "Ĉinio" achter "Zaandam" komen te staan] GoTo 77258 End If matchBinary = False If Not Nulvector Then 'Bij kritische letters (c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ ): Speciale voorbehandeling > en < vergelijking. LenWoord = Len(lijstwoord) For iKritChar = 1 To nKritChar 'Vergelijking tussen Zoekwoord en lijstwoord: iChar = KritCharPos(1, iKritChar) If iChar > LenWoord Then Exit For If AscW(Mid(lijstwoord, iChar, 1)) = KritCharPos(2, iKritChar) Then 'Eerste letterpositie (vanaf links) in beide woorden ontdekt met Tegengesteld Kritische letters ( c - ĉ , g - ĝ , ....); 'Check of ook linkerwoorddelen daaraan voorafgaand gelijk zijn: If Left(key, iChar - 1) = Left(lijstwoord, iChar - 1) Then matchBinary = True: Exit For End If Next iKritChar '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) End If 'Mix van vbText- en vbBinary-compare is nodig ivm ESP-DICT-SORTERING van TaalwoordLijst If Not matchBinary Then 'N.B. Er mogen daarbij GEEN HOOFDLETTERS staan in zoekwoord of TaalWoordLijst! KorG = StrComp(key, lijstwoord, vbTextCompare) 'KorG' = (lees:) "Kleiner Of Gelijk", als volgt: KorG=-1 betekent Kleiner; KorG=1 betekent Groter; KorG=0 betekent Gelijk. Else 'If matchBinary Then 'MsgBox "Tegengesteld Kritische Teken(s) op zelfde letterpositie(s), bij I = " & I KorG = StrComp(key, lijstwoord, vbBinaryCompare) 'ivm Tegengesteld Kritische Teken(s) op zelfde letterpositie(s) End If 77258: 'If key < lijstwoord Then 'key < lijstwoord (zoek verder in onderhelft) If KorG = -1 Then ':MsgBox "<" high = middle - 1 GoTo 77101 'ElseIf key > lijstwoord Then 'key > lijstwoord (zoek verder in bovenhelft) ElseIf KorG = 1 Then ':MsgBox ">" low = middle + 1 If MetEigennaamBezig Then If low > IendEigennaam Then low = IendEigennaam Else If low > Iend Then low = Iend End If GoTo 77101 Else 'If KorG = 0 Then 'key = lijstwoord ("toevallige voortijdige" match!) low = middle MatchPos = middle 'MsgBox "Match! TaalWoord- of Eigennaam- Lijst-positie = " & MatchPos GoTo 77700 '(binair zoekproces beeindigd) End If Else high = low GoTo 77101 '(binair zoekproces nog niet beeindigd) End If 77700: 'Uitgang bij Match: 'MsgBox "tekstwoord '" & TekstWoord & "' gevonden in TaalWoord- of Eigennaam-Lijst" MorfeemStruct = .worksheets(Wsh).Cells(MatchPos, Structkolom) ' ... dus pak de daarbij opgeslagen MorfeemStruct If MorDisVarNumb = 1 Then 'bij kennelijke oproep door MontruMorDisEnVorto: If .worksheets(Wsh).Cells(MatchPos, Structkolom + 1) <> "" Then Alternativoj = True '(to trigger MontruMorDisEnVorto for adding a Dotted Underline) ElseIf MorDisVarNumb > 1 And MorfeemStruct = "" Then 'bij kennelijke oproep door VariiguMorDisEnVorto: indien er GEEN verdere Variant meer is, dan: If MorDisVarNumb = 2 Then MsgBox "Error: GEEN Variant bij gestippeld onderstreept woord" '(kolom 10 leeg ! ) 'Indien kolom 11 of kolom 12 leeg wordt aangetroffen, dan weer terug naar (de default) kolom 9.... Structkolom = 9 MorfeemStruct = .worksheets(Wsh).Cells(MatchPos, Structkolom) MorDisVariant = 1 ' ....en de Private variable MorDisVariant weer op 1 zetten End If GoTo 800 'Uitgang bij GEEN Match: 700 [zie hieronder] '++++++++++++++++++++++++++++++++++++++++++einde QUASI SUBROUTINE++++++++++++++++++++++++++++++++++++++++ 700: 'GEEN Match If Not MetEigennaamBezig Then 'tekstwoord is kennelijk GEEN Taalwoord, maar een Eigennaam: MetEigennaamBezig = True Wsh = 3 GoTo 70001 Else SercxuMorDisEnVorto = False GoTo 900 End If 800: End With SercxuMorDisEnVorto = True 900: End Function Sub AldonuNovanVorton() ' 7 april 2008 TW '[ankorau en prepar-fazo] 'een aangeklikt (geslecteerd) "fout" woord (rood gemarkeerd, met geribbelde onderstreping) wordt ... '... verklaard tot Nieuw taalwoord (neologisme, vakterm, gebruikerseigene term), en toegevoegd aan het (ESPSOF-)Woordenboek. 'I. in de TaalwoordLijst wordt de VortSpecMarko "f" vervangen door N, A, etc (afh. van uitgang van het woord); ' het aantal occurrences valt daar af te lezen. 'II. de aangeklikte maar ook alle andere occurrences van ditzelfde woord in de tekstfile worden "ontrood"; ' dit geldt ook voor evt. majusklitaj occurences (Unmarked Caps) 'III. het woord wordt toegevoegd in Dict3 (algemeen onderdeel van ESPSOF) of Dict4 (gebruikerseigen woordenboek); ' daartoe is een binair zoekproces, een Insert, en een update van de betreffende kolomlengte vereist. End Sub Sub KashuCxiujnMorDis() ' 04-Nov-06 TW [antaua nomo: GeenMorDisTekens ] ' KAŜU (uzu Alt+K): ' kaŝas ĉiujn MorDis-signojn ( MorDIs = Morfem-Disigo; la Unikodaj signoj 183 kaj 65123 estas uzata por respektive videbligi kaj interne enkodi ĝin) ' haalt MorDisTekens Weg MorDisVariant = 1 '[2-6-08] 'Indien zojuist voor 1 woord een Montru (Alt+M) opdracht was gegeven, ... '...dan worden alleen van dat woord de MorDis-tekens weer ongedaan gemaakt [15-16-08] , .... If UnuVortIsOn Then If Selection.Characters(1).Start = iPosCursorFontoTeksto Then ' ...mits de Cursor nog achter datzelfde woord staat ActiveDocument.Undo Selection.Collapse direction:=wdCollapseEnd '[18-6-08] GoTo 10 End If End If 'In alle andere gevallen worden de MorDis-tekens in ALLE woorden worden weer ongedaan gemaakt: If CxiujnWasThere Then 'ter versnelling bij afwisselend 'KashuCxiujn'en 'MontruCxiujn [15-6-08] ActiveDocument.Redo CxiujnWasThere = False GoTo 10 End If 'If NOT CxiujnWasThere (indien MorDis-tekens reeds geplaatst waren tijdens Tekstanalyse): Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = ChrW(MorDis) .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 10: MorDisWasThere = True UnuVortIsOn = False '18-6-08 End Sub Sub MontruCxiujnMorDis() '04-Nov-06 TW [vroegere naam: WelMorDisTekens ] ' CXIUJN (uzu Alt+C): '(re-)montras MorDis-signojn ' brengt MorDisTekens weer terug (of, als ze er nog helemaal niet geweest zijn, vraag dan aan gebruiker om TEKSTanal op te roepen) ' MorDisVariant = 1 '[2-6-08] If MorDisWasThere Then '[19-6-08] ActiveDocument.Undo MorDisWasThere = False '[15-11-06] de switch 'MorDisWasThere' (tussen de 2 macros) verhindert dat drukken op knop Montru kan leiden tot andere Undo's CxiujnWasThere = True '[5-16-08] GoTo 90 End If If Not JustFinishedTekstKontrol Then If MsgBox("montri chiujn morfemlimojn postulas re-analizi la tutan tekston," & vbCr & vbCr & _ " chu re-startigi TEKSTanal ?", vbYesNo) = vbYes Then Call TEKSTanal End If 90: End Sub Sub AnstatauigMorDisSignojn() '17-Nov-06 TW [vroeger naam: VervangAlleMorDisTekens ] ' SIGNOJ: 'dit macro vervangt in een op het scherm staande textfile alle (eventueel nog vanuit vroegere versie aanwezige) Unicode 65123 MorDisTekens door Unicode 183 Tekens; 'de zin hiervan is dat Unicode 65123 Tekens een onvoorspelbare character-spacing teweegbrengen: soms goed, soms veel te wijd; 'in het laatste geval heeft men dan de mogelijkheid via een menu-knop ('Signoj', in menu 'Kodoj') al deze tekens te vervangen door Unicode 183 Tekens; Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:="" Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = ChrW(65123) .Replacement.Text = ChrW(183) If MsgBox("Change small dot to lower hyphen, throughout all split words?", vbYesNo) = vbYes Then .Text = ChrW(183) .Replacement.Text = ChrW(65123) End If .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll MorDisWasThere = True End Sub Sub TEKSTanal() '31-01-09 (een aantal MsgBoxen bij fouten tijdens SVO-analyse zijn hierin afgeklemd door tijdelijke toevoeging van commentaar-apostrof) '30-01-09 (met MsgBoxen bij fouten tijdens SVO-analyse) 'ESPSOF Versio 0.95 30 januaro 2009 TW (Toon Witkam) 'TEKSTanal (antaua nomo 'EspTekstAnalizilo') estas la chefprogamo por TekstAnalizo (Literum-Kontrolo). 'Ghi kontrolas tekston ne dum sed POST la tajpado. 'Startigu ghin (che MS WORD dosiero) per sinsekva alklako de: TOOLS - MACROS - TEKSTanal '(au uzu prefere Alt+T) 'Private EspsofExcel As Object [zie bovenaan Module] [9-5-08] 'Private EspsofVORTAR As String [zie bovenaan Module] 'Private EspsofREGREZ As String [zie bovenaan Module] 'Private WstatWordtoExcel As Object [zie bovenaan Module] [26-5-08] Dim CijferWoordOpslag(750) As String Dim RetadresoOpslag(250) As String Dim LeestekenWoordOpslag(250) As String Dim PropNamAuxNum(25) As Long '[27-3-08] Dim PropNamAuxWoord(25) As String '[27-3-08] Dim Lengte As Integer Dim iZin As Integer Dim jTekstWoord As Integer Dim TekstWoordNummer As Long '[27-3-08] Dim nPropNamSequence As Long '[27-3-08] Dim iLijstWoord As Long Dim iLijstWstatn As Integer Dim WstatnLijstWoord As Long Dim WstatnTaalWoord As Long Dim WstatnLijstEigennaam As Integer Dim WstatnEigennaam As Integer Dim MogelijkBeginZinsQuotering As Boolean Dim nAfstrippingenAchterkant As Integer Dim nFields As Integer Dim TekstWoord As String Dim TekstWoordVoorAfstrippen As String Dim ChBegin As String Dim ChEnd As String Dim WstatnCijferWoord As Integer Dim nRetadreso As Integer Dim nLeestekenWoord As Integer Dim LosLeestekenWoord As Boolean Dim nOverspringCursief As Long Dim nOverspringTutmajuskl As Integer Dim nOverspringInter As Integer Dim nOverspringInter1 As Integer Dim nOverspringInter2 As Integer Dim nOverspringInter3 As Integer Dim nOverspringInter4 As Integer Dim nOverspringInter5 As Integer Dim Overspring1Begin As Integer Dim Overspring2Begin As Integer Dim Overspring3Begin As Integer Dim Overspring4Begin As Integer Dim Overspring5Begin As Integer Dim AjnTransSalt As Boolean Dim TransSaltSpeco As Integer Dim nSpringAlert As Integer Dim nSpringAlert1 As Integer Dim nSpringAlert2 As Integer Dim nSpringAlert3 As Integer Dim nSpringAlert4 As Integer Dim nSpringAlert5 As Integer Dim Inter5Speco As Integer Dim LeestekenBijWoord As Boolean Dim nEntrySamenvoeging As Integer Dim WstatnUnmarkedCap As Integer Dim UnmarkedCap As Boolean Dim alleenCursief As Boolean Dim textfield As String Dim textZinslengte As String Dim nZinsLengte As Integer Dim WstatnAantalZinnen As Integer Dim WstatnTotaalAanZinslengten As Long Dim HulpString As String Dim wildehoofdlweggehaald As Boolean Dim nWoordWildeHoofdlettersWeg As Integer Dim nLijst As Integer Dim i As Integer Dim j As Long Dim kk As Long Dim StartProcessing As Single Dim EndProcessing As Single Dim ProcessingTime As Single Dim VortSpecEnFrazo1 As String Dim VortSpecEnFrazo2 As String Dim ZinSTR As String Dim VortSpecMarko As String Dim VortSpecoBeginQuote As Boolean Dim VortSpecoEindQuote As Boolean Dim VortSpecoBeginHaak As Boolean Dim VortSpecoSluitHaak As Boolean Dim BeginHaakQuoteSpeco(4) As Integer '[14-4-2008] Dim EindHaakQuoteSpeco(4) As Integer '[14-4-2008] Dim JesBegin As Boolean '[14-4-2008] Dim JesEind As Boolean '[14-4-2008] Dim VortSpecoKommaEtc As Boolean Dim KommaEtc As String Dim nPuntAangeplakt As Integer Dim VortSpecoHaltoStreko As Boolean Dim textAlineaZinsnummer As String Dim AlineaNummer As Integer '[23-4-08] Dim TekstWoordVoor0000Conversie As String Dim SamenstellingOrHyphenatedIndicator As String Dim key As String Dim lijstwoord As String Dim low As Long Dim high As Long Dim middle As Long Dim MatchPos As Long Dim InsertPos As Long Dim InsertPosTaalwoord As Long Dim InsertPosEigennaam As Long Dim NowInserting As Boolean Dim iPosMarkedOccurrence As Long Dim iPosUnmarkedOccurrence As Long Dim nEOf As Integer Dim nEOfUpgrade As Integer Dim nEOfUpgradeFailed As Integer Dim EBOinTaalwoordLijst As Boolean Dim WstatnNulEntry As Integer Dim TekstAfstand As Long Dim TekstAfstandsBovengrens As Long Dim nOproepCheckEspWord As Long Dim BronCode As String Dim KritCharPos(2, 25) As Integer Dim iKritChar As Integer Dim nKritChar As Integer Dim iChar As Integer Dim k As Integer Dim m As Integer Dim A As String Dim Nulvector As Boolean Dim matchBinary As Boolean Dim LenWoord As Integer 'Dim LenW As Integer '[23-12-08] '[18-1-09: bleek overbodig] Dim KorG As Integer Dim i1 As Long Dim Iend As Long Dim i1Eigennaam As Long Dim IendEigennaam As Long Dim MetEigennaamBezig As Boolean Dim Wsh As Integer Dim Rkolom As Integer 'Dim MarkFremdVortojInSource As Boolean 'kan weg [12-5-08] 'Dim ShowSpecDividSignoInSource As Boolean 'kan weg [12-5-08] Dim WoordIsSamenstelling As Boolean Dim struct(4) As String Dim nstruct As Integer Dim synmark As Integer Dim genvoc As Integer Dim Ambigumark As String Dim WoordOpWoordPositie(250) As String Dim iTijdelijkeTest As Integer Dim WoordPositiesSVO(50, 3) As Integer Dim ntrio As Integer Dim itrio As Integer Dim SubjWoord As String Dim ObjWoord As String Dim VerbWoord As String Dim SVOvolgorde As String Dim iSVOlijst As Long Dim iRegelInSVOlijst As Integer Dim iLoop115 As Integer Dim ZinOverslaan As Boolean Dim SyntacticAnalysis As Boolean Dim BrontekstFilenaam As String Dim LijstLengte As Long Dim nSVOentries As Long Dim nZinsbouwEntries As Long Dim RezultMapNaam As String Dim EvtAZMfield As String Dim nFoutOfFremdWoord As Long Dim nHalfFoutOfFremdWoord As Long Dim nNeEnvortaraKunmeto As Long Dim nFouteSamenstelling As Long Dim nFieldsPreview As Integer Dim OverschrijvingNulEntry As Boolean Dim StamAdjectief As String '[29-3-2008] Dim UitgangAdjectief As String '[29-3-2008] Dim i1KopregelLijst As Integer '[24-4-08] Dim iKopregelLijst As Integer '[24-4-08] Dim MajusklaVort As Boolean '[24-4-08] Dim PreviousMajusklaVort As Boolean '[24-4-08] Dim nMordisTekens As Long '[13-5-08] Dim VortKombino As Boolean '[6-7-08] Dim OptionalHyphen As Boolean '[4-9-08] Dim iPosOptionalHyphen As Integer '[12-12-08] Dim PlaatsingOptHyphens As Boolean '[12-12-08] Dim nTotaalAantalTaalWoorden As Long '[23-12-08] Dim WstatnTotaalTaalWoordlengten As Long '[23-12-08] Dim taalwlenmax As Integer '[23-12-08] Dim WoordLengte(50) As Long '[23-12-08] Dim WstatnTotaalKwadrWoordlengten As Long '[23-12-08] Dim GemiddeldeWoordlengte As Single '[23-12-08] Dim StdDeviatieWoordlengte As Single '[23-12-08] Dim SkippedSentences(50) As String '[16-1-09] Dim nSkipped As Integer '[16-1-09] Dim MainText As Boolean '[9-1-08] 'Public FootnotesBeingProcessed As Boolean [zie bovenaan Module] '[27-12-08] 'Public EndnotesBeingProcessed As Boolean [zie bovenaan Module] '[27-12-08] Dim iPosOriginal As Long '[30-1-09] Dim iPosTemporary As Long '[30-1-09] CalledByTekstAnal = True '[10-3-08] MorDisVariant = 1 '[2-6-08] nAantalAlineas = 0 '[1-5-09] FootnotesBeingProcessed = False '[8-1-09] EndnotesBeingProcessed = False '[8-1-09] MainText = True '[9-1-08] PlaatsingOptHyphens = True 'OPTIE (nu default; in toekomst evt. uitschakelbaar via EnigoTEKSTanal) '[12-12-08] 1: BrontekstFilenaam = ActiveDocument.Name BrontekstFilenaam = Left(BrontekstFilenaam, Len(BrontekstFilenaam) - 4) '(haal ".doc" van de filenaam af) 'BrontekstFilenaam = ActiveDocument.FullName '(volledige PathName) 'MsgBox "Fontotekst-dosiero = " & BrontekstFilenaam EspsofVORTAR = "C:\ESPSOF\ESPSOF-VORTAR.xls" EspsofREGREZ = "C:\ESPSOF\ESPSOF-REGREZ.xls" 'Vast Worksheet-gebruik: 'Wsh 2: TaalWoordLijst (Sheet 2 van file Nieuwe WoordStatistiek.xls) 'Wsh 3: EigennaamLijst (Sheet 3 van file Nieuwe WoordStatistiek.xls) 'Kolom-gebruik in de TaalWoordLijst: 'kolom 1: [nog open] 'kolom 2: TekstWoord zelf 'kolom 3: AbsFrequentie ervan in de Tekstfile 'kolom 4: VortSpecMarko 'kolom 5: SynMark (Syntactic Mark uit "3 supersnelle Dicts") '[30-10-06] 'kolom 6: Ambigumark ("EBON", "EBON4", "EBONj", "EBOA", ...) '[3-2-2008] 'kolom 7: GenVoc (Vocabulary Category "3 supersnelle Dicts") '[30-10-06] 'kolom 8: SamenstellingOrHyphenatedIndicator '[30-10-06] 'kolom 9: Struct variant 1 (Voorkeursvariant) '[30-10-06] 'kolom 10: Struct variant 2 '[30-10-06] 'kolom 11: Struct variant 3 '[30-10-06] 'kolom 12: Struct variant 4 '[30-10-06] 'Rkolom=12 (Rkolom is de meest Rechtse mee te sorteren kolom) '[*30-10-06: veranderd van 6 in 12] i1 = 2 'beginpositie van de TaalWoordLijst is ... Iend = i1 '... tevens aanvankelijke eindpositie van de TaalWoordLijst 'Kolom-gebruik in de EigennaamLijst: 'kolom 2: Eigennaam zelf 'kolom 3: AbsFrequentie ervan in de Tekstfile 'kolom 4: VortSpecMarko (in de EigennaamLijst is dat bijv: "E", "EB", "EB&N", "EOf", "EBON4", "EOAj4", etc) 'kolom 5: Asimil-Marko ( 1 = Asimilita Propra Nomo) 'kolom 6: Ambigumark ("EBON", "EBON4", "EBONj", "EBOA", ...) '[3-2-2008] 'kolom 7: Propra-Nomo Kategorio 'kolom 8: [nog open] 'kolom 9: Struct (bij Asimilita Propra Nomo) 'Rkolom=9 (Rkolom is de meest Rechtse mee te sorteren kolom) i1Eigennaam = i1 'beginpositie van de EigennaamLijst is gelijk aan die van de TaalWoordLijst, en is ... IendEigennaam = i1 '... tevens aanvankelijke eindpositie van de EigennaamLijst InsertPos = i1 'begin-InsertPositie voor TaalWoordLijst InsertPosEigennaam = i1Eigennaam 'begin-InsertPositie voor EigennaamLijst 'Kolom-gebruik in de S-V-O-lijst (Worksheet 6): '[7 juni 2007] iSVOlijst = 1 '===============================ivm Invoer-Dialoog=============================== 'omdat gewenst is dat invoerwaarden bij elke volgende run (in een en dezelfde SESSIE) van TEKSTanal ... '... aanvankelijk nog staan op de eerder door gebruiker ingestelde waarden, wordt met STATIC variables gewerkt: Static RunNumbDuringSession As Integer Static RunNumbMiMemPretigis As Integer 'Static RughiguErarFremd As Boolean 'verwijderd als invoervariabele; rood maken van fouten is permanente instelling [12-5-08] 'Static AnkauDict3 As Boolean '2-8-08 => Private AnkauDict3 As Boolean 'Static TutaPIV As Boolean '2-8-08 => Private TutaPIV As Boolean 'Static GenVoc16only As Boolean '2-8-08 => Private GenVoc16only As Boolean 'Static BROonly As Boolean '2-8-08 => Private BROonly As Boolean 'Static AnkauPrivatVortaro As Boolean '2-8-08 => Private AnkauPrivatVortaro As Boolean Static BluiguNeEnvort As Boolean Static MaxLenSenBluig As Integer Static SkipTutmajuskl As Boolean Static SkipKursiv As Boolean Static UnuopVort As Boolean Static AjnanTekst As Boolean Static SkipApostr As Boolean 'Inter1 'HaakQuoteSpeco = 10 Static SkipDuoblApostr As Boolean 'Inter2 'HaakQuoteSpeco = 11 Static SkipRektajKramp As Boolean 'Inter3 'HaakQuoteSpeco = 2 Static SkipAngulajKramp As Boolean 'Inter4 'HaakQuoteSpeco = 3 Static SkipSpecifaOpcio As Boolean 'Inter5 'HaakQuoteSpeco = 1,12,13,14,15,16,17,18,19: Static Opcio1 As Boolean 'HaakQuoteSpeco = 1 Static Opcio12 As Boolean 'HaakQuoteSpeco = 12 Static Opcio13 As Boolean 'HaakQuoteSpeco = 13 Static Opcio14 As Boolean 'HaakQuoteSpeco = 14 Static Opcio15 As Boolean 'HaakQuoteSpeco = 15 Static Opcio16 As Boolean 'HaakQuoteSpeco = 16 Static Opcio17 As Boolean 'HaakQuoteSpeco = 17 Static Opcio18 As Boolean 'HaakQuoteSpeco = 18 Static Opcio19 As Boolean 'HaakQuoteSpeco = 19 Static LapostrAkceptu As Boolean Static OapostrAkceptu As Boolean Static UNTauUTparticip As Boolean 'Static ArkaikCiAkceptu As Boolean => Private ArkaikCiAkceptu As Boolean 'Static StreketoEnNombrGhis100 as Boolean => Private StreketoEnNombrGhis100 As Boolean [9-7-08] Static ProvuKorektadonSkan As Boolean Static SkanErarParoj As String Static MorphemizerSwitchedOn As Boolean Static DisigNurNeEnvort As Boolean Static DisigChiujnVort As Boolean Static DisigNurPlilong As Boolean Static MaxLenSenDisig As Integer Static ListiguSintaksEnExcel As Boolean Static MontruSintaksEnFonto As Boolean Static PretiguExcelAutomate As Boolean '-------------aangeraden defaults oftewel startwaarden (Static Variables!):------------- '(worden slechts eenmalig geeffectueerd, aan het BEGIN VAN EEN SESSIE): If RunNumbDuringSession = 0 Then 'Reeds by default aangeklikt of ingesteld (alle niet genoemde invoerdingen staan op nul of false): 'RughiguErarFremd = True '(niet aleen default, maar permanente instelling [12-5-08]) AnkauDict3 = True '(TutaPIV, GenVoc16only, BROonly zijn per default 'false' ) SkipTutmajuskl = True MaxLenSenBluig = 12 UnuopVort = True SkipSpecifaOpcio = True 'betreft Inter5: aanvankelijk is GEEN van de 13 'Opcioj' aangeklikt; de gebruiker kiest wellicht ... '... 1 van de 13 opties, klikt die aan, maar zou dan waarschijnlijk vergeten ook het keuzevakje "au inter" aan te klikken; ... ' ... daarom wordt aan het begin van een sessie dit keuzevakje aangeklikt neergezet; indien de gebruiker besluit van GEEN ... ' ... van de 13 opties gebruik te maken kan hij altijd nog het keuzevakje ("au inter") wegklikken. DisigNurNeEnvort = True MaxLenSenDisig = 12 PretiguExcelAutomate = True CustomizationContext = NormalTemplate 'asigni klavkombinojn per kiuj la uzanto povas facile alvoki jenajn makroojn [9-6-08]: KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyT, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="TEKSTanal" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyM, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="MontruMorDisEnVorto" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyV, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="VariiguMorDisEnVorto" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyK, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="KashuCxiujnMorDis" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyC, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="MontruCxiujnMorDis" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyA, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="AldonuNovanVorton" KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyQ, wdKeyAlt), KeyCategory:=wdKeyCategoryMacro, Command:="KVEK" '(door de klavkombino-toewijzing HIER te plaatsen kan de gebruiker die TEKSTanal in een sessie niet nodig heeft, ... ' ...volstaan met een aanroep van TEKSTanal gevolgd door het aanklikken van 'NULIGU' in de invoerdialoog) End If '--------------------------------invoerblok:-------------------------------- '(wordt geeffectueerd BIJ ELKE RUN tijdens de sessie): RunNumbDuringSession = RunNumbDuringSession + 1 10: 'Reset flags: statusEnigoTEKSTanal = 0 '-----------------------Invoer-Dialoog zelf: --------------------------- 'Vraag gebruiker keuzes en opties in te voeren, 'middels speciaal daarvoor gemaakte UserForm: Load EnigoTEKSTanal With EnigoTEKSTanal 'aktuele WORD-filenaam (Fontotekst-dosiero): .aanwijzingTekstDosiero.Caption = "Pritraktota tekstdosiero: " & BrontekstFilenaam .NumeroUnuaAlineo.Value = 1 'meest recent ingestelde waarden (keren terug in dialoogvenster): '.Rughigu.Value = True '(niet slechts default, maar permanente instelling) .PIVkajDict3.Value = AnkauDict3 '2-8-08 .PIVentute.Value = TutaPIV '2-8-08 .PIVnurGenVoc16.Value = GenVoc16only '2-8-08 .BROsole.Value = BROonly '2-8-08 .UzuAnkau.Value = AnkauPrivatVortaro '2-8-08 .Bluigu.Value = BluiguNeEnvort .LongecoBluo.Value = MaxLenSenBluig .Tutmajusklajn.Value = SkipTutmajuskl .Kursivajn.Value = SkipKursiv .Unuopajn.Value = UnuopVort .Ajnan.Value = AjnanTekst .Inter1.Value = SkipApostr 'HaakQuoteSpeco = 10 .Inter2.Value = SkipDuoblApostr 'HaakQuoteSpeco = 11 .Inter3.Value = SkipRektajKramp 'HaakQuoteSpeco = 2 .Inter4.Value = SkipAngulajKramp 'HaakQuoteSpeco = 3 .Inter5.Value = SkipSpecifaOpcio 'HaakQuoteSpeco = 1,12,13,14,15,16,17,18,19: .Option1.Value = Opcio1 'HaakQuoteSpeco = 1 .Option12.Value = Opcio12 'HaakQuoteSpeco = 12 .Option13.Value = Opcio13 'HaakQuoteSpeco = 13 .Option14.Value = Opcio14 'HaakQuoteSpeco = 14 .Option15.Value = Opcio15 'HaakQuoteSpeco = 15 .Option16.Value = Opcio16 'HaakQuoteSpeco = 16 .Option17.Value = Opcio17 'HaakQuoteSpeco = 17 .Option18.Value = Opcio18 'HaakQuoteSpeco = 18 .Option19.Value = Opcio19 'HaakQuoteSpeco = 19 .lartikolo.Value = LapostrAkceptu .findeOvortoj.Value = OapostrAkceptu .UNTkajUT.Value = UNTauUTparticip .cipronomo.Value = ArkaikCiAkceptu .Dividstrekon1199.Value = StreketoEnNombrGhis100 '2-8-08 .Provu.Value = ProvuKorektadonSkan .SKANER.Value = SkanErarParoj .MontruMorfemDisig.Value = MorphemizerSwitchedOn .Nurneenvortaraj.Value = DisigNurNeEnvort .Chechiuj.Value = DisigChiujnVort .Nurplilongaj.Value = DisigNurPlilong .LongecoDisig.Value = MaxLenSenDisig .ListiguExcel.Value = ListiguSintaksEnExcel .MontruFonto.Value = MontruSintaksEnFonto .AutomatePretigu.Value = PretiguExcelAutomate .MiMemPrizorgis.Value = Not PretiguExcelAutomate 16: .Show '(vbModal) '[2-5-08:] multithreading (tijdens dialoog laden van Excelfiles) dmv vbModeless werkt niet If statusEnigoTEKSTanal = 1 Then GoTo 16112 'uzanto premis la butonon "Bone" ( = "OK") ElseIf statusEnigoTEKSTanal <= 0 Then 'statusEnigoTEKSTanal = 0: uzanto forigis la EnigFenenstron per alklako de ties supradekstra angula (aŭ per la klavkombino Alt+F4); 'statusEnigoTEKSTanal = -1: uzanto premis la butonon "Nuligu" ( = "Cancel"); 'gebruiker ziet alsnog af van het opstarten van ESPSOF (bijv. omdat het "Pritaktota tekstdosiero" niet het bedoelde is, 'of omdat het invoerscherm alleen werd opgeroepen om eerder gemaakte instellingen te bekijken ): If statusEnigoTEKSTanal = -1 Then Unload EnigoTEKSTanal 'het dialoog-venster wordt verwijderd GoTo 9999 'uzanto premis "Nuligu" ( = "Cancel") End If 16112: 'haal Dialoogvenster weg [dit is de ENIGE manier om het VBA-programma verder te laten gaan! 5-5-08]: 'On Error Resume Next .Hide 'de zgn. 'modale' dialoog wordt afgesloten '-------------------------Lezen van invoervelden:------------------------- iNummer1eAlinea = .NumeroUnuaAlineo.Value 'RughiguErarFremd = .Rughigu.Value 'wegclicken van RUĜIGU wordt genegeerd [12-5-08] AnkauDict3 = .PIVkajDict3.Value '2-8-08 TutaPIV = .PIVentute.Value '2-8-08 GenVoc16only = .PIVnurGenVoc16.Value '2-8-08 BROonly = .BROsole.Value '2-8-08 AnkauPrivatVortaro = .UzuAnkau.Value '2-8-08 BluiguNeEnvort = .Bluigu.Value If .LongecoBluo.Value = "" Then .LongecoBluo.Value = 0 '[30-6-08] MaxLenSenBluig = .LongecoBluo.Value SkipTutmajuskl = .Tutmajusklajn.Value SkipKursiv = .Kursivajn.Value UnuopVort = .Unuopajn.Value AjnanTekst = .Ajnan.Value SkipApostr = .Inter1.Value 'Inter1 SkipDuoblApostr = .Inter2.Value 'Inter2 SkipRektajKramp = .Inter3.Value 'Inter3 SkipAngulajKramp = .Inter4.Value 'Inter4 SkipSpecifaOpcio = .Inter5.Value 'Inter5 LapostrAkceptu = .lartikolo.Value OapostrAkceptu = .findeOvortoj.Value UNTauUTparticip = .UNTkajUT.Value ArkaikCiAkceptu = .cipronomo.Value StreketoEnNombrGhis100 = .Dividstrekon1199.Value '2-8-08 'StreketoEnNombrGhis100 = True ' <== optie voor toestaan StreketoEnNombrGhis100 voorlopig nog hier aan of uitzetten [9-7-08] ProvuKorektadonSkan = .Provu.Value SkanErarParoj = .SKANER.Value MorphemizerSwitchedOn = .MontruMorfemDisig.Value DisigNurNeEnvort = .Nurneenvortaraj.Value DisigChiujnVort = .Chechiuj.Value DisigNurPlilong = .Nurplilongaj.Value If .LongecoDisig.Value = "" Then .LongecoDisig.Value = 0 '[30-6-08] MaxLenSenDisig = .LongecoDisig.Value ListiguSintaksEnExcel = .ListiguExcel.Value MontruSintaksEnFonto = .MontruFonto.Value PretiguExcelAutomate = .AutomatePretigu.Value 'Logische verwerking van (evt. onjuiste) invoercombinaties: ScanProblemIl = False 'resets ScanProblem1l = False ScanProblemCC = False ScanProblemSS = False ScanProblemjj = False ScanProblemrnm = False ScanProblemmrn = False If ProvuKorektadonSkan Then If SkanErarParoj <> "" Then 'ALLEEN SkanErarParoj waarvoor in onderstaande lijst van IF-stmts (met een Boolean) is voorzien zijn zinvol: SkanErarParoj = " " & SkanErarParoj & "," '(ook het eerste en laatste SkanErarParo moet zijn voorafgegaan door een spatie en beindigd door een komma) If InStr(1, SkanErarParoj, " I-l,") Then ScanProblemIl = True 'hoofdletter I is mogelijk foute weergave van kleine letter l If InStr(1, SkanErarParoj, " 1-l,") Then ScanProblem1l = True 'cijfer 1 is mogelijk foute weergave van kleine letter l If InStr(1, SkanErarParoj, " rn-m,") Then ScanProblemrnm = True 'kleine letters r n is mogelijk foute weergave van kleine letter m If InStr(1, SkanErarParoj, " m-rn,") Then ScanProblemmrn = True 'kleine letter m is mogelijk foute weergave van kleine letters r n If InStr(1, SkanErarParoj, " j-" & ChrW(309) & ",") Then ScanProblemjj = True 'kleine letter j is mogelijk foute weergave van kleine letter ĵ If InStr(1, SkanErarParoj, " C-" & ChrW(264) & ",") Then ScanProblemCC = True 'hoofdletter C is mogelijk foute weergave van hoofdletter Ĉ If InStr(1, SkanErarParoj, " S-" & ChrW(348) & ",") Then ScanProblemSS = True 'hoofdletter S is mogelijk foute weergave van hoofdletter Ŝ End If End If 17: If SkipSpecifaOpcio Then Opcio1 = .Option1.Value 'HaakQuoteSpeco = 1 Opcio12 = .Option12.Value 'HaakQuoteSpeco = 12 Opcio13 = .Option13.Value 'HaakQuoteSpeco = 13 Opcio14 = .Option14.Value 'HaakQuoteSpeco = 14 Opcio15 = .Option15.Value 'HaakQuoteSpeco = 15 Opcio16 = .Option16.Value 'HaakQuoteSpeco = 16 Opcio17 = .Option17.Value 'HaakQuoteSpeco = 17 Opcio18 = .Option18.Value 'HaakQuoteSpeco = 18 Opcio19 = .Option19.Value 'HaakQuoteSpeco = 19 If Not (Opcio1 Or Opcio12 Or Opcio13 Or Opcio14 Or Opcio15 Or Opcio16 Or Opcio17 Or Opcio18 Or Opcio19) Then SkipSpecifaOpcio = False End If End If If Not (SkipApostr Or SkipDuoblApostr Or SkipRektajKramp Or SkipAngulajKramp Or SkipSpecifaOpcio) Then UnuopVort = False AjnanTekst = False ElseIf SkipSpecifaOpcio Then 'bij gebruik van Optie Inter5: If Opcio1 Then Inter5Speco = 1 'Unicode 40 en 41 'gewone (ronde) openings- en sluithaak If Opcio12 Then Inter5Speco = 12 'Unicode 8216 en 8217 'gekrulde hoge enkele begin- en eindaanhalingsteken If Opcio13 Then Inter5Speco = 13 'Unicode 8218 en 8217 'gekrulde lage enkele begin- en hoge enkele eindaanhalingsteken If Opcio14 Then Inter5Speco = 14 'Unicode 8220 en 8221 'gekrulde hoge dubbele begin- en eindaanhalingsteken If Opcio15 Then Inter5Speco = 15 'Unicode 8222 en 8221 'gekrulde lage dubbele begin- en hoge dubbele eindaanhalingsteken If Opcio16 Then Inter5Speco = 16 'Unicode 8223 en 8221 'gekrulde hoge dubbele begin- en eindaanhalingsteken (reversed-9 aan begin) If Opcio17 Then Inter5Speco = 17 'Unicode 8249 en 8250 'enkele spitse openings- en sluit-quotehaak If Opcio18 Then Inter5Speco = 18 'Unicode 171 en 187 'dubbele spitse openings- en sluit-quotehaak If Opcio19 Then Inter5Speco = 19 'Unicode 8222 en 8220 'gekrulde lage dubbele begin- en gekrulde hoge dubbele reversed-9 eind-aanhalingsteken '[19-5-08] Else 'If SkipApostr ("Inter1", HaakQuoteSpeco = 10): 'Unicode 39 en 39 'enkele apostrof 'If SkipDuoblApostr ("Inter2", HaakQuoteSpeco = 11): 'Unicode 34 en 34 'simpele dubbele apostrof 'If SkipRektajKramp ("Inter3", HaakQuoteSpeco = 2): 'Unicode 91 en 93 'vierkante openings- en sluithaak 'If SkipAngulajKramp ("Inter4", HaakQuoteSpeco = 3): 'Unicode 60 en 62 'spitse openings- en sluithaak (kleiner-dan en groter-dan teken) End If MorphemizerSwitchedOn = MorphemizerSwitchedOn And (DisigChiujnVort Or DisigNurNeEnvort) SyntacticAnalysis = ListiguSintaksEnExcel Or MontruSintaksEnFonto End With Unload EnigoTEKSTanal '============================einde Invoer-Dialoog================================= If PretiguExcelAutomate Then Call AtentigoTrairoFonto1 'er wordt een Textbox neergezet aan het begin van de brontekst-WORD-file; 'deze Textbox attendeert de gebruiker op evt. tijd nodig voor het automatisch gereed maken van VORTAR-files etc., 'en ook op de daaropvolgende "antau-trairoj" (door AFM-bazo). Set EspsofExcel = CreateObject("Excel.Application") 'er wordt een nieuwe instantie van Excel klaargezet EspsofExcel.Workbooks.Open EspsofVORTAR 'open file EspsofExcel.Workbooks.Open EspsofREGREZ 'open file Set WstatWordtoExcel = GetObject(EspsofREGREZ) '[6-5-08] Call AtentigoTrairoFonto2 'verwijdering van de Textbox aan het begin van de WORD-file; 'deze Textbox, die de gebruiker attendeert op "antau-trairoj", wordt nu weer weggehaald, ... 'voordat met de brontekstfile (en met het selecteren van andere elementen dan de Textbox) begonnen wordt Else 'If MiMemPrizorgis Then: RunNumbMiMemPretigis = RunNumbMiMemPretigis + 1 If RunNumbMiMemPretigis = 1 Then MsgBox "Certigu ke " & EspsofVORTAR & vbCr & _ "kaj krome " & EspsofREGREZ & vbCr & _ "estas malfermitaj ! " & vbCr & vbCr & _ "Nur poste premu 'OK' " End If Set WstatWordtoExcel = GetObject(EspsofREGREZ) With WstatWordtoExcel 'Extra check op leeg (schoongeveegd) zijn van file EspsofREGREZ: If .worksheets(2).Cells(2, 2) <> "" Or .worksheets(2).Cells(2, 3) <> "" Or .worksheets(3).Cells(2, 2) <> "" Then '(check op Taalwoord- en Eigennaamlijst) 'If MsgBox("Dosiero ESPSOF-REGREZ jam entenas datumoj: forvishi tiujn?", vbYesNo, "EspKONTR.TEKSTAnal") = vbNo Then GoTo 9999 For i = 8 To 10 'SCHOONVEGEN kolommen H, I en J van Worksheet 1: '[29-2-08] .worksheets(1).Columns(i).ClearContents 'Overzicht Next i .worksheets(1).Cells(130, 9).Value = "SignoVortListo:" '(herstel kopje) For i = 2 To 6 Step 2 'SCHOONVEGEN kolommen B, D en F van Worksheet 1: '[29-2-08] .worksheets(1).Columns(i).ClearContents 'Overzicht Next i For i = 1 To 12 'SCHOONVEGEN 12 kolommen A t/m L) van vier andere Worksheets: '[10-2-07] .worksheets(2).Columns(i).ClearContents 'Taalwoorden .worksheets(3).Columns(i).ClearContents 'Eigennamen 'Worksheets(4) 'wordt schoongeveegd door macro KunmetAnaliz .worksheets(5).Columns(i).ClearContents 'Zinsbouw .worksheets(6).Columns(i).ClearContents 'S-V-O Next i .worksheets(3).Columns(27).ClearContents 'PropNamSequence [27-3-08] .worksheets(3).Columns(28).ClearContents 'PropNamSequence [27-3-08] End If End With 'If MiMemPrizorgis And.... 'If ListiguSintaksEnExcel Then [26-5-08:] niet meer nodig na toevoeging van 'On Error Resume Next' boven label 1699 'MsgBox "Se vi metis la dosieron ESPSOF-REGREZ sur la ekrano," & vbCr & _ ' "vi nepre malfermu ghian laborfolion ''S-V-O'', alie okazos Eraro! " 'End If End If 'Samenvattende gegevens komen (pas bij de Eindbehandeling) op Sheet 1. 'De TaalwoordLijst met frequentie, VortSpecMarko en morfeemstructuur komt op Sheet 2; 'De Eigennaamlijst komt op Sheet 3; 'De dynamische kladblok voor VortKunmet-analyse komt op Sheet 4. iKglobal = 0 'ivm CumulatiefKladBlok '[19-10-08] 'De VortSpecEnFrazo-STRING van elke AZM-zin, alsmede de Kopregel-Lijst, komen op Sheet 5. 'Syntaktische gegevens (SVO, Inf-O) komen in Sheet 6. '- - - - - - - - - - - - - - - - - - - - - -Verwerking van de Tekstfile in MS WORD:- - - - - - - - - - - - - - - - - - - - - StartProcessing = Timer If Not TekstoKajNotojAparte Then '[27-12-08] ' in default modus wordt de hele tekstfile, dwz MainText, evt.Footnotes en evt. EndNotes, behandeld: ' omdat het niet zeker is dat op het moment van Tekstanal-oroep de cursor in de MainText staat, ' zijn de volgende twee statements wenselijk: ActiveDocument.StoryRanges(wdMainTextStory).Select 'hierdoor wordt het Gewone Tekstgedeelte (MainText) geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat de hele tekst "zwart" wordt End If 10000: '[27-12-08] 'Check of Tekstfile niet reeds (geheel of gedeeltelijk) in Morfeem-gesplitste staat verkeert [13-5-08]: 'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:="" '[ge-deaktiveerd 27-12-08] Selection.Find.ClearFormatting With Selection.Find 'het zoeken van MorDis-tekens [ ChrW(183) of ChrW(65123) ]: .Text = ChrW(MorDis) .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False End With 21: Selection.Find.Execute 'iPosChar = Selection.Characters(1).Start '[30-1-09: kan en moet weg] If Selection.Find.Found = False Then GoTo 22 '[21-1-09] Selection.MoveStart unit:=wdCharacter, Count:=-1 '[10-1-09]: Selection.MoveEnd unit:=wdCharacter, Count:=1 'negeer Unicode-183 of -65123 tekens die NIET tussen 2 Letters in staan If Not Letter(Selection.Characters(1).Text) Then GoTo 27 '(deze tekens kunnen soms deel uitmaken van de brontekst... If Not Letter(Selection.Characters(3).Text) Then GoTo 28 ' ...en daarin voor andere doeleinden zijn gebruikt) 26: nMordisTekens = nMordisTekens + 1 Selection.MoveStart unit:=wdCharacter, Count:=3 'cursor wordt gepositioneerd voor zoeken van volgende MorDis-teken GoTo 21 28: 'Check op evt. uitzondering: '[21-1-09] If Selection.Characters(3).Text = ChrW(31) Then GoTo 26 'een MorDis-teken kan ook vlak voor een Optional Hyphen staan '[21-1-09] 27: 'Geen echt MorDis-teken: [10-1-09] Selection.Characters(2).Text = ChrW(8231) 'vervang MorDis-teken door Unicode 8231 (ziet er praktisch hetzelfde uit als MorDisteken, ...) Selection.Characters(2).Font.Name = "Arial Unicode MS" '...althans in bepaalde Fonts) Selection.Characters(2).Font.Size = 8 '[dit om de kans op ongewenste verandering regelafstand (door Font-verandering van 1 teken) te minimaliseren;... '...indien zo'n verandering van de brontekst onacceptabel blijkt, moet ipv ChrW(8231) een simpele komma (zonder Fontverandering) worden gebruikt] '[14-1-09] Selection.MoveStart unit:=wdCharacter, Count:=2 'cursor wordt DIRECT ACHTER het aangetroffen en vervangen MorDis-teken gezet [10-1-09] Selection.Collapse direction:=wdCollapseStart GoTo 21 22: 'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:="" '[ge-deaktiveerd 27-12-08, en vervangen door:] If MainText Then '[27-12-08] ActiveDocument.StoryRanges(wdMainTextStory).Select 'hierdoor wordt het Gewone Tekstgedeelte geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat de hele tekst "zwart" wordt ElseIf FootnotesBeingProcessed Then ActiveDocument.StoryRanges(wdFootnotesStory).Select 'hierdoor wordt het Footnote-deel geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat de hele tekst "zwart" wordt ElseIf EndnotesBeingProcessed Then ActiveDocument.StoryRanges(wdEndnotesStory).Select 'hierdoor wordt het Endnote-deel geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat de hele tekst "zwart" wordt End If If Not nMordisTekens = 0 Then 'Tekstfile bevat MorfeemSplits-Tekens: If MainText Then If MsgBox("Chi tiu fontotekst-dosiero estas jam pritraktita de ESPSOF," & vbCr & _ "char ghi entenas MORFEM-DISIGILOJN - chu vi volas tekst-analizon denove?", vbYesNo, _ Title:="EspKONTR.TEKSTAnal") = vbNo Then GoTo 9999 'kvazau uzanto premis "Nuligu" ( = "Cancel") ElseIf FootnotesBeingProcessed Then If MsgBox("La PIEDNOTOJ de la dosiero estas jam pritraktitaj de ESPSOF," & vbCr & _ "char ili entenas MORFEM-DISIGILOJN - chu vi volas tekst-analizon denove?", vbYesNo, _ Title:="EspKONTR.TEKSTAnal") = vbNo Then GoTo 9999 'kvazau uzanto premis "Nuligu" ( = "Cancel") ElseIf EndnotesBeingProcessed Then If MsgBox("La FINAJ NOTOJ de la dosiero estas jam pritraktitaj de ESPSOF," & vbCr & _ "char ili entenas MORFEM-DISIGILOJN - chu vi volas tekst-analizon denove?", vbYesNo, _ Title:="EspKONTR.TEKSTAnal") = vbNo Then GoTo 9999 'kvazau uzanto premis "Nuligu" ( = "Cancel") End If 'If vbYes: Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = ChrW(MorDis) .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False End With Selection.Find.Execute Replace:=wdReplaceAll 'MsgBox "Alle " & nMordisTekens & " nMordisTekens verwijderd" End If '------------------ 'ActiveDocument.Select If MorphemizerSwitchedOn Then 'Essentieel voor een juiste weergave van MorDis (morfeemscheidingstekens) is ... ' ...dat de hele source-file tevoren wordt ingesteld op een daarvoor geschikt Font: If MainText Then 'Selection.Font.Name = "Arial Unicode MS" Selection.Font.Name = "Tahoma" ElseIf FootnotesBeingProcessed Then Selection.Font.Name = "Arial Unicode MS" 'Selection.Font.Name = "Tahoma" ElseIf EndnotesBeingProcessed Then Selection.Font.Name = "Arial Unicode MS" 'Selection.Font.Name = "Tahoma" End If End If Selection.Collapse direction:=wdCollapseStart '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: '[23-2-2008] ' nFields = ActiveDocument.Fields.Count ' If nFields = 0 Then GoTo 43 '(helemaal geen Fields in file) ' nFieldsPreview = nFields ' If nFieldsPreview > 10 Then nFieldsPreview = 10 '(als bij de eerste 10 Fields geen AZM-Field is, dan zal worden aangenomen... ' '...dat er helemaal geen AZM-Fields in de file staan) ' For iZin = 1 To nFieldsPreview ' ActiveDocument.Fields(iZin).Select ' 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 & "Chi tiu tekstdosiero estas jam (parte) pritraktita de ESPSOF," & vbCr & _ ' "char ghi entenas FrazKomencMarkojn"), _ ' Title:="EspKONTR.TEKSTAnal" '8-3-2008 ' 'MsgBox ("AZM-plus" & vbCr & vbCr & "reeds AZM-Field aangetroffen in deze file") '23-2-2008 ' GoTo 45 'ga aan de slag met TekstAnalizo (AZMenWstat is niet meer nodig) ' End If ' Next iZin '43: 'vooralsnog GEEN AZM-Fields aangetroffen: ' 'MsgBox ("Geen AZM-fields aangetroffen in deze file") Call EspWSTAT.AFMbazo '[10-3-2008] 'Call AZMenWstat.AlineaEnZinsMarkeerder '[23-2-2008] 'Call AZMSuperPlus.AlineaEnZinsMarkeerder '[evt. in toekomst] If MainText Then '[27-12-08] nFields = ActiveDocument.Fields.Count '[23-2-2008] ElseIf FootnotesBeingProcessed Then nFields = ActiveDocument.StoryRanges(wdFootnotesStory).Fields.Count '[5-1-09] ElseIf EndnotesBeingProcessed Then nFields = ActiveDocument.StoryRanges(wdEndnotesStory).Fields.Count '[29-1-09] End If 45: '[Laat gebruiker evt. een verkorte Filenaam opgeven, voor duurzame archivering van de taalstatistische gegevens: ' BronCode = Left(InputBox("Verkorte naam van de tekstfile (max. 8 tekens):", "NummeringsBasis Woord- en Zins-Statistiek"), 8)] 50: 'RESETS: nPositiveDictSearches = 0 'reset (deze PRIVATE statische variabele) voor elk tekstdosiero [23-3-08] nNegativeDictSearches = 0 'reset (deze PRIVATE statische variabele) voor elk tekstdosiero [23-3-08] nPropNamSequence = 1 '[27-3-08] i1KopregelLijst = 2 'beginpositie van de KopregelLijst in Wsh=5 [24-4-08] iKopregelLijst = i1KopregelLijst 'beginstand voor doorzoeken KopregelLijst [24-4-08] nSpringAlert = 150 'in te stellen aantal oversprongen woorden waarbij een Msgbox waarschuwt ... ' ... dat in de tekst misschien een sluithaak of eindquote vergeten is [19-4-08]; 'bij nSpringAlert=150 komt de Alert na 150, 300, 450... oversprongen woorden Selection.Find.ClearFormatting 'reset eventuele eerdere instellingen van Find; in de grote... '...programma-lussen 'iZin' en 'jTekstWoord' wordt Find (onder label 253) herhaaldelijk gebruikt With WstatWordtoExcel 'Ga de Fields van alle zinnen langs: '------------------------------------------------------------------------------------------------------------------------------------------------ 'GRANDA ITERACIO TRA ĈIUJ (AZM- / KomencMarkitaj-) FRAZOJ DE LA TEKST-DOSIERO: '------------------------------------------------------------------------------------------------------------------------------------------------ 100: 'GROTE BUITENLUS (VOOR ALLE ZINNEN IN DE TEKST-FILE): For iZin = 1 To nFields 'met elk Field correspondeert precies 1 zin If MainText Then '[27-12-08] ActiveDocument.Fields(iZin).Select 'MsgBox ActiveDocument.Fields(iZin).Code.Text textfield = ActiveDocument.Fields(iZin).Code.Text ElseIf FootnotesBeingProcessed Then ActiveDocument.StoryRanges(wdFootnotesStory).Fields(iZin).Select '[5-1-09] textfield = ActiveDocument.StoryRanges(wdFootnotesStory).Fields(iZin).Code.Text ElseIf EndnotesBeingProcessed Then ActiveDocument.StoryRanges(wdEndnotesStory).Fields(iZin).Select '[5-1-09] textfield = ActiveDocument.StoryRanges(wdEndnotesStory).Fields(iZin).Code.Text End If If InStr(4, textfield, ".,") = 0 Then 'indien ".," ontbreekt dan is dit geen AZM-field '[22-2-2008] GoTo 17000 End If '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) '[28-11-05] nZinsLengte = CDec(textZinslengte) VortSpecEnFrazo1 = BronCode & " " & textAlineaZinsnummer VortSpecEnFrazo2 = "" 'schoonvegen VortSpecEnFrazo-STRING voor nieuwe zin ZinOverslaan = False 'INGITA ITERACIO TRA ĈIUJ VORTOJ DE FRAZO (laŭ la vortnombro indikita en la AZM- /FrazKomencMarko): 'GROTE BINNENLUS (VOOR ALLE WOORDEN IN EEN ZIN): For jTekstWoord = 1 To nZinsLengte 'doorlopende nummering van alle tekstwoorden, voor Text Coherence toepassingen [27-3-08]: TekstWoordNummer = TekstWoordNummer + 1 'wij houden aan, als basisprincipe: SPATIE = WOORDGRENS spaceto = vortlimo If jTekstWoord = 1 Then 'If jTekstWoord = 1 Then MsgBox "BEGIN of loop" ' j=1 betekent: eerste woord van een zin Selection.Collapse direction:=wdCollapseEnd nAfstrippingenAchterkant = 0 '[*26-11-05] VortKombino = False '[6-7-08] (voor alle zekerheid) End If iLoop115 = 0 115: Lengte = Selection.MoveEndUntil(Cset:=" " & Chr(160) & vbCr & vbTab & vbLf & Chr(11) & Chr(12) & vbCrLf, Count:=50) - 1 'ook Tab, Linefeed, vbCr etc. gelden ALTIJD als woordgrens '-----------toevoeging 7-5-08---------------: '[7-5-08]: opvangen van evt. "Cursief-bij-Bullet"-fout (alleen indien jTekstwoord <> 1 ): If jTekstWoord <> 1 Then If Selection.Characters(1).Text = Chr(19) Then 'tekstwoord begint met openingshaak Fieldcode, dus is GEEN echt tekstwoord Selection.Collapse direction:=wdCollapseStart TekstWoordNummer = TekstWoordNummer - 1 PreviousTekstWoord = "" nZinsLengte = nZinsLengte - 1 'corrigeren van de te lang (door MS VBA) berekende zinslengte 'nu deze zinslengte ook nog corrigeren in het voorafgaande AZM-Field: ActiveDocument.Fields(iZin).Code.Select 'zet selectie op inhoud van voorafgaande AZM-Field Selection.MoveStart unit:=wdCharacter, Count:=InStr(4, textfield, ".,") + 1 Selection.TypeText CStr(nZinsLengte) Lengte = Selection.MoveEndUntil(Cset:=Chr(19), Count:=50) - 1 Lengte = Lengte - 1 '(voor onberispelijke check Lengte > 50 hieronder) Selection.Collapse direction:=wdCollapseEnd GoTo 169 'einde zin End If End If '--------einde toevoeging --------- If Lengte > 50 Then 'Woordlengte (incl. sommige leestekens) is max. 50 ! 'MsgBox "De maximale woordlengte (50 letters, incl. sommige leestekens) wordt OVERSCHREDEN:" & vbCr & _ ' "De lengte van het laatst gelezen woord is " & Lengte & " tekens!" MsgBox "La maksimuma vortlongeco estu 50 literoj au signoj:" & vbCr & _ "aperis vorto kies longeco estas " & Lengte & " !", _ Title:="EspKONTR.TEKSTAnal" End If If Lengte > 0 Then GoTo 120 '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 iLoop115 = iLoop115 + 1 '[beveiliging tegen eeuwige loop] [30-7-2007]: 'If iLoop115 > 16 Then ' MsgBox "teveel rare (lees-)tekens in deze zin" ' ZinOverslaan = True ' GoTo 169 '[30-7-2007] 'End If If iLoop115 > 16 Then 'MsgBox "Tro da strangaj (interpunkciaj) signoj en tiu chi frazo:" & vbCr & "ghi NE estos (sintakse) analizita !", _ 'Title:="EspKONTR.TEKSTAnal" ZinOverslaan = True nSkipped = nSkipped + 1 '[16-1-09] If Not (nSkipped > 50) Then SkippedSentences(nSkipped) = textAlineaZinsnummer '[16-1-09] GoTo 169 '[30-7-2007] End If GoTo 115 120: TekstWoord = Selection.Text Lengte = Len(TekstWoord) VortSpecoHaltoStreko = False WoordIsSamenstelling = False 'afvangen van losstaande gedachtenstreep, sprekerswisselingsteken (lange streep), en gespatieerde ellipsis: If Lengte = 1 Then If TekstWoord = "-" Or TekstWoord = Chr(150) Or TekstWoord = ChrW(8212) Or TekstWoord = "." Or TekstWoord = "," Then '[24-5-08:] toevoeging ChrW(8211) leek niet nodig VortSpecoHaltoStreko = True '[*24-11-2005] jTekstWoord = jTekstWoord - 1 'correctie voor pseudo-woord dat door eerdere AZM macro niet is meegeteld in nZinsLengte 'pseudo-woord oversprongen GoTo 160 End If End If 'we hebben nu een TekstWoord te pakken (met mogelijk nog aangeplakte leestekens 'aan beide zijden) ' 'VERWERKING PER TEKSTWOORD: ' 'intacthouden van L-apostrophe (lidwoord met elisie, zoals in het Frans, Italiaans, Esperanto): If Lengte = 2 Then 'er zijn diverse Unicode-apostrofen; hier worden herkend: Unicodes 39, 900, 8217 en 8242: If TekstWoord = "l'" Or TekstWoord = "l" & ChrW(900) _ Or TekstWoord = "l" & ChrW(8217) Or TekstWoord = "l" & ChrW(8242) _ Or TekstWoord = "L'" Or TekstWoord = "L" & ChrW(900) _ Or TekstWoord = "L" & ChrW(8217) Or TekstWoord = "L" & ChrW(8242) Then If jTekstWoord = nZinsLengte Then VortSpecMarko = "f": GoTo 166 'L-apostrof aan eind van zin is altijd fout [11-5-08] 'L-apostrophe als apart tekstwoord (gevolgd door spatie) aangetroffen [11-5-08]: If LapostrAkceptu Then ChBegin = Left(TekstWoord, 1) TekstWoord = ChBegin & ChrW(8242) 'voor o.a. de WoordLijst (in Excel) wordt Unikode 8242 ... GoTo 243 ' ... de standaard-apostrofe bij lidwoord-elisie [17-4-2008] Else 'If LapostrAkceptu = False: 'L-apostrophe is door ESPSOF-gebruiker NIET toegestaan: 'VortSpecMarko = "f": GoTo 166 VortSpecMarko = "f": GoTo 160 '[18-5-08]: opdat "f" in VortSpecMarkoEnFrazo-string komt End If '[einde toevoeging 11-5-08] End If End If 'verwijderen evt. optional hyphens: TekstWoord = HaalOptionalHyphensWegUitWoord(TekstWoord, OptionalHyphen) If OptionalHyphen Then Lengte = Len(TekstWoord) 'toegevoegd 4-9-08 'MsgBox "tekstwoord = " & TekstWoord 'Afstrippen Leestekens, haken, aanhalingstekens etc. die zonder spatie aan het woord zitten: LeestekenBijWoord = False LosLeestekenWoord = False MogelijkBeginZinsQuotering = False VortSpecoBeginQuote = False VortSpecoEindQuote = False VortSpecoBeginHaak = False VortSpecoSluitHaak = False VortSpecoKommaEtc = False nPuntAangeplakt = 0 '[31-7-07] For i = 1 To 4 BeginHaakQuoteSpeco(i) = 0 '[14-4-2008] EindHaakQuoteSpeco(i) = 0 '[14-4-2008] Next i i = 0 TekstWoordVoorAfstrippen = TekstWoord 235: 'Afstrippen Leestekens aan Voorkant: ChBegin = Left(TekstWoord, 1) If Letter(ChBegin) Or Cijfer(ChBegin) Then i = 0: GoTo 238 LeestekenBijWoord = True Lengte = Lengte - 1 'strip leesteken aan voorkant If Lengte = 0 Then 'LeestekenWoord '[16-4-2008] If Len(TekstWoordVoorAfstrippen) > 1 Then GoTo 290 'woord bestaat uit alleen maar leestekens (en meer dan 1 leesteken) LosLeestekenWoord = True 'woord bestaat uit precies 1 leesteken [GoTo 290 wordt nu uitgesteld tot boven label 241] Else TekstWoord = Right(TekstWoord, Lengte) Selection.MoveStart unit:=wdCharacter, Count:=1 '(dit ivm controle op cursief, hieronder) End If 'controle op openingshaken en beginaanhalingstekens '[14-4-2008]: i = i + 1 If i > 4 Then GoTo 235 'maximale combinatie van openingshaken en beginaanhalingstekens is 4 tekens, bijv. <[(" If ChBegin = "(" Then 'Unikodo [17-4-2008]: BeginHaakQuoteSpeco(i) = 1 '40 = simpele ronde openingshaak ElseIf ChBegin = "[" Then: BeginHaakQuoteSpeco(i) = 2 '91 = vierkante openingshaak ElseIf ChBegin = "<" Then: BeginHaakQuoteSpeco(i) = 3 '60 = spitse openingshaak (kleiner-dan teken) ElseIf ChBegin = ChrW(39) Then: BeginHaakQuoteSpeco(i) = 10 '39 = enkele apostrof ElseIf ChBegin = ChrW(34) Then: BeginHaakQuoteSpeco(i) = 11 '34 = simpele dubbele apostrof ElseIf ChBegin = ChrW(8216) Then: BeginHaakQuoteSpeco(i) = 12 '8216 = gekrulde hoge enkele begin-aanhalingsteken ElseIf ChBegin = ChrW(8218) Then: BeginHaakQuoteSpeco(i) = 13 '8218 = gekrulde lage enkele begin-aanhalingsteken ElseIf ChBegin = ChrW(8220) Then: BeginHaakQuoteSpeco(i) = 14 '8220 = gekrulde hoge dubbele begin-aanhalingsteken ElseIf ChBegin = ChrW(8222) Then: BeginHaakQuoteSpeco(i) = 15 '8222 = gekrulde lage dubbele begin-aanhalingsteken 'ElseIf ChBegin = ChrW(8222) Then: BeginHaakQuoteSpeco(i) = 19 '8222 = gekrulde lage dubbele begin-aanhalingsteken '[19-5-08] ElseIf ChBegin = ChrW(8223) Then: BeginHaakQuoteSpeco(i) = 16 '8223 = gekrulde hoge dubbele reversed-9 begin-aanhalingsteken ElseIf ChBegin = ChrW(8249) Then: BeginHaakQuoteSpeco(i) = 17 '8249 = enkele spitse openings-quotehaak ElseIf ChBegin = ChrW(171) Then: BeginHaakQuoteSpeco(i) = 18 '171 = dubbele spitse openings-quotehaak '[**door invoeging van "(Not LosLeestekenWoord) And" kan elk van bovenstaande haken/quotes worden uitgesloten als ze losstaand zijn; 16-4-08] '**evt. sprekerswisselingsteken (zie hierboven onder label 120) nog toevoegen End If If BeginHaakQuoteSpeco(i) > 0 And BeginHaakQuoteSpeco(i) < 10 Then VortSpecoBeginHaak = True ElseIf BeginHaakQuoteSpeco(i) >= 10 Then VortSpecoBeginQuote = True If Not LosLeestekenWoord Then '[uitsluiting hier van losstaande begin-quotes is conform VortSpecMarkiloj en Syntax-verwerking t/m 2007] If BeginHaakQuoteSpeco(i) = 12 Or BeginHaakQuoteSpeco(i) >= 14 Then MogelijkBeginZinsQuotering = True End If End If If LosLeestekenWoord Then If BeginHaakQuoteSpeco(1) > 0 Then 'losstaande openingshaak of beginaanhalingsteken aangetroffen: GoTo 240 'de AjnTransSalt- en AjnanTekst-codeblokken hieronder (tussen label 240 en 241) worden nu doorlopen Else 'losstaande sluithaak of eindaanhalingsteken mogelijk aan te treffen: i = 0: ChEnd = ChBegin: GoTo 237 End If End If GoTo 235 238: 'Afstrippen Leestekens aan Achterkant: ChEnd = Right(TekstWoord, 1) If Letter(ChEnd) Or Cijfer(ChEnd) Then 'gewijzigd 7-1-2008: If nPuntAangeplakt = 1 Then If jTekstWoord <> nZinsLengte Then 'TekstWoord middenin de zin (NIET aan Zinseinde): '------------20-2-2008:------------ 'Om ingeval van 1 of meer (zonder updating van het AZM-Field) uit een zin weggehaalde woorden toch het laatste woord in die zin... '...nog goed te kunnen behandelen, zonder dat de punt achter dat laatste woord als leksikaal onderdeel ervan gezien wordt: 'Selection.MoveStart unit:=wdWord, Count:=3 [30-1-09: deze versie liep FOUT ingeval van afkortings-woord dicht bij File-einde] 'Selection.MoveEnd unit:=wdCharacter, Count:=6 'Deze voorziening is dus een soort "genade" voor de gebruiker die na een... 'EvtAZMfield = Selection.Text '...EspTekstAnalizilo-run bij het nakijken van de (roodgemaakte) fouten... 'Selection.MoveEnd unit:=wdCharacter, Count:=-6 '...bij wijze van correctie een woord weghaalt (of twee woordstukken samenvoegt)... 'Selection.MoveStart unit:=wdWord, Count:=-3 '...zonder daarbij in de AZM van die zin de Zinslengte-aanduiding aan te passen. 'Selection.Collapse direction:=wdCollapseStart 'Selection.MoveEnd unit:=wdCharacter, Count:=Len(TekstWoord) '----- iPosOriginal = Selection.Characters(1).Start '[30-1-09: nieuwe versie] Selection.MoveStart unit:=wdWord, Count:=3 'Deze voorziening is dus een soort "genade" voor de gebruiker die na een... iPosTemporary = Selection.Characters(1).Start '...EspTekstAnalizilo-run bij het nakijken van de (roodgemaakte) fouten... Selection.MoveEnd unit:=wdCharacter, Count:=6 '...bij wijze van correctie een woord weghaalt (of twee woordstukken samenvoegt)... EvtAZMfield = Selection.Text '...zonder daarbij in de AZM van die zin de Zinslengte-aanduiding aan te passen. Selection.MoveStart unit:=wdCharacter, Count:=iPosOriginal - iPosTemporary Selection.Collapse direction:=wdCollapseStart Selection.MoveEnd unit:=wdCharacter, Count:=Len(TekstWoord) '[30-1-09: einde nieuwe versie] '--- If AscW(Mid(EvtAZMfield, 1, 1)) = 19 And InStr(3, EvtAZMfield, "-") <> 0 Then GoTo 240 '(Ascii 19 is code voor Field-Openingshaak... If Cijfer(Left(EvtAZMfield, 1)) And InStr(2, EvtAZMfield, "-") <> 0 Then GoTo 240 '...maar werkt niet altijd, zodat deze tweede test nodig is) End If 'Indien het Tekstwoord een Afkorting (mallongigo) is, wordt de eerder verwijderde punt toch als deel van het TekstWoord behandeld, ... '[29-1-2008] A = TekstWoord '...voor latere woordenboekcontrole van een Op Punt Eindigende Afkorting. If A = "anst" Or A = "ekz" Or A = "eld" Or A = "i.a" Or A = "ibid" Or A = "inkl" Or A = "k" Or A = "kp" Or A = "p" Or A = "p" & ChrW(285) Or A = "par" Or A = "prof" Or A = "proks" Or _ A = "red" Or A = "rim" Or A = "t.e" Or A = "t.n" Or A = "trad" Or A = "vd" Or A = "vol" Or A = "bv" Or A = "k.a" Or A = "k.s" Or A = "ktp" Or _ A = "k.t.p" Or A = "resp" Or A = "a.K" Or A = "p.K" Or A = ChrW(265) Or A = ChrW(265) & "ap" Or A = "in" & ChrW(285) Then 'van deze 29 zijn de laatste 3: ĉ. , ĉap. , inĝ. TekstWoord = A & "." 'terugzetten van punt in variabele 'Tekstwoord' End If End If GoTo 240 End If 'einde toevoeging 7-1-2008 cq. 29-2-2008 LeestekenBijWoord = True 'Welk leesteken staat er aangeplakt achter het woord: komma, puntkomma, dubbele punt, punt(en), ? [*26-11-2005]: If ChEnd = "," Or ChEnd = ";" Or ChEnd = ":" Or ChEnd = "?" Or ChEnd = "!" Then VortSpecoKommaEtc = True KommaEtc = ChEnd '(de gewone leestekens blijven behouden in de VortSpecEnFrazo-registratie) ElseIf ChEnd = "." Then VortSpecoKommaEtc = True nPuntAangeplakt = nPuntAangeplakt + 1 'ellipsis (3 of meer puntjes) wordt op streepje (Ascii 45) afgebeeld: '[31-7-07] If nPuntAangeplakt > 2 Then KommaEtc = "-" Else KommaEtc = "." 'twee punten achter elkaar op 1 punt afgebeeld '[2-8-07, voor robuustheid] ElseIf ChEnd = ChrW(8230) Then 'ChrW(8230 = 3 puntjes (ellipsis) VortSpecoKommaEtc = True KommaEtc = "-" 'een 'tripunkto' ellipsis wordt op streepje (Ascii 45) afgebeeld '[31-7-07] Else 237: 'controle op sluithaken en eindaanhalingstekens '[14-4-2008]: i = i + 1 If i > 4 Then GoTo 239 'maximale combinatie van sluithaken en eindaanhalingstekens is 4 tekens, bijv. ")]> If ChEnd = ")" Then 'Unikodo [17-4-2008]: EindHaakQuoteSpeco(i) = 1 '41 = simpele ronde sluithaak ElseIf ChEnd = "]" Then: EindHaakQuoteSpeco(i) = 2 '93 = vierkante sluithaak ElseIf ChEnd = ">" Then: EindHaakQuoteSpeco(i) = 3 '62 = spitse sluithaak (groter-dan teken) ElseIf ChEnd = ChrW(39) Then: EindHaakQuoteSpeco(i) = 10 '39 = enkelele apostrof ElseIf ChEnd = ChrW(34) Then: EindHaakQuoteSpeco(i) = 11 '34 = simpele dubbele apostrof ElseIf ChEnd = ChrW(8217) Then: EindHaakQuoteSpeco(i) = 12 '8217 = gekrulde hoge enkele eind-aanhalingsteken 'ElseIf ChEnd = ChrW(8217) Then: EindHaakQuoteSpeco(i) = 13 '8217 = gekrulde hoge enkele eind-aanhalingsteken ElseIf ChEnd = ChrW(8221) Then: EindHaakQuoteSpeco(i) = 14 '8221 = gekrulde hoge dubbele eind-aanhalingsteken 'ElseIf ChEnd = ChrW(8221) Then: EindHaakQuoteSpeco(i) = 15 '8221 = gekrulde hoge dubbele eind-aanhalingsteken 'ElseIf ChEnd = ChrW(8221) Then: EindHaakQuoteSpeco(i) = 16 '8221 = gekrulde hoge dubbele eind-aanhalingsteken ElseIf ChEnd = ChrW(8250) Then: EindHaakQuoteSpeco(i) = 17 '8250 = enkele spitse sluit-quotehaak ElseIf ChEnd = ChrW(187) Then: EindHaakQuoteSpeco(i) = 18 '187 = dubbele spitse sluit-quotehaak ElseIf ChEnd = ChrW(8220) Then: EindHaakQuoteSpeco(i) = 19 '8220 = gekrulde hoge dubbele reversed-9 eind-aanhalingsteken '[19-5-08] '[**door invoeging van "(Not LosLeestekenWoord) And" kan elk van bovenstaande haken/quotes worden uitgesloten als ze losstaand zijn; 16-4-08] End If '--------- If Not VortSpecoKommaEtc And i = 1 Then 'Toevoeging1 [6-7-08] ivm VortKombino: If (EindHaakQuoteSpeco(1) = 10 Or EindHaakQuoteSpeco(1) = 12) Then If Left(TekstWoord, 4) = "dank" Or Left(TekstWoord, 4) = "Dank" Then If jTekstWoord <= nZinsLengte - 1 Then '(indien dank' of Dank' is laatste woord zin, dan kan van VortKombino < dank' al > geen sprake zijn) VortKombino = True 'VortKombino < dank' al > kan in combinatie met een volgend zinswoord mogelijk zijn: Selection.Collapse direction:=wdCollapseEnd Selection.MoveStart unit:=wdCharacter, Count:=1 PreviousTekstWoord = TekstWoord If Left(TekstWoord, 4) = "dank" Then PreviousMajusklaVort = False Else PreviousMajusklaVort = True GoTo 161 End If End If End If End If 'einde toevoeging1 [6-7-08] '-------- If EindHaakQuoteSpeco(i) > 0 And EindHaakQuoteSpeco(i) < 10 Then VortSpecoSluitHaak = True ElseIf EindHaakQuoteSpeco(i) >= 10 Then VortSpecoEindQuote = True If Not LosLeestekenWoord Then '[uitsluiting hier van losstaande begin-quotes is conform VortSpecMarkiloj en Syntax-verwerking t/m 2007] If VortSpecoBeginQuote Then MogelijkBeginZinsQuotering = False 'indien er een begin-quote en een eind-quote om hetzelfde woord heen staan... End If '...dan is er GEEN sprake van een ZINS-quotering maar van een woord-quotering. End If End If If LosLeestekenWoord Then If EindHaakQuoteSpeco(1) > 0 Then 'losstaande sluithaak of eindaanhalingsteken aangetroffen: GoTo 240 'de AjnTransSalt- en AjnanTekst-codeblokken hieronder (tussen label 240 en 241) worden nu doorlopen Else 'het LosLeestekenWoord is GEEN (in bovenstaand codeblok opgenomen) haak of quote GoTo 290 End If End If End If 239: Lengte = Lengte - 1 'strip leesteken aan achterkant nAfstrippingenAchterkant = nAfstrippingenAchterkant + 1 'ivm correct doorschuiven selectie naar volgend woord [25-5-03] TekstWoord = Left(TekstWoord, Lengte) Selection.MoveEnd unit:=wdCharacter, Count:=-1 '(dit ivm controle op cursief, hieronder) If Lengte = 2 Then 'controle op fout gebruik van L-apostrof [11-5-08]: If jTekstWoord = nZinsLengte Then If ChBegin = "l" Then 'L-apostrof (voorafgegaan door spatie) aan eind van zin is altijd fout: ChEnd = Right(TekstWoord, 1) If AscW(ChEnd) = 39 Or AscW(ChEnd) = 900 Or AscW(ChEnd) = 8217 Or AscW(ChEnd) = 8242 Then VortSpecMarko = "f": GoTo 166 End If End If End If End If '[einde toevoeging 11-5-08] GoTo 238 240: 'afstrippen van leestekens voltooid, 'we hebben nu een "schoon" TekstWoord gereed staan If VortKombino Then 'Toevoeging2 [6-7-08] ivm VortKombino: If Left(PreviousTekstWoord, 4) = "dank" Or Left(PreviousTekstWoord, 4) = "Dank" Then If TekstWoord = "al" Then 'If Left(PreviousTekstWoord, 5) = "dank'" Then TekstWoord = "dank' al" 'If Left(PreviousTekstWoord, 5) = "dank" & ChrW(8217) Then TekstWoord = "dank" & ChrW(8217) & " al" TekstWoord = Left(PreviousTekstWoord, 5) & " al" '[6-10-08] Else 'GEEN sprake van VortKombino < dank' al > of < Dank' al > : If Not OapostrAkceptu Then 'dan wordt < dank + volgendwoord > als FOUT opgeslagen in de tekst-TaalwoordLijst, ... '...en wordt dezelfde woordcombinatie in z'n geheel rood gemaaakt in de tekst: 'TekstWoord = "dank' " & TekstWoord 'TekstWoord = "dank" & ChrW(8217) & " " & TekstWoord TekstWoord = Left(PreviousTekstWoord, 5) & " " & TekstWoord '[6-10-08] Selection.MoveStart unit:=wdCharacter, Count:=-6 Else 'If OapostrAkceptu: 'indien de elisie-optie voor Nouns gezet was wordt < dank > hoewel het correct was TOCH NIET opgeslagen... '...of bijgeteld in de tekst-TaalwoordLijst, louter en alleen om een grote hoeveelheid extra coderingswerk te besparen; ... '...uiteraard wordt dan het erop volgend woord helemaal normaal behandeld End If End If End If VortKombino = False 'reset End If 'eind toevoeging2 [6-7-08] '============== If TekstWoord = "xyz" Then '### s p e c i a a l v o o r t e s t s ### s p e c i a a l v o o r t e s t s ### TekstWoord = TekstWoord End If '============== If AjnTransSalt Then 'opzoek naar sluithaak of eind-aanhalingsteken, 'als EIND van een nog lopend tekst-traject voor Overspringen-van-woorden: 'Enkele apostrof (Inter1): If VortSpecoEindQuote And TransSaltSpeco = 10 Then 'ivm SkipApostr JesEind = False For i = 1 To 4 If EindHaakQuoteSpeco(i) = 10 Then JesEind = True Next i If JesEind Then AjnTransSalt = False: TransSaltSpeco = 0: nOverspringInter1 = nOverspringInter1 + 1 'reset End If '(tot en met aantreffen Enkele apostrof wordt woord oversprongen) 'Dubbele apostrof (Inter2): If VortSpecoEindQuote And TransSaltSpeco = 11 Then 'ivm SkipDuoblApostr JesEind = False For i = 1 To 4 If EindHaakQuoteSpeco(i) = 11 Then JesEind = True Next i If JesEind Then AjnTransSalt = False: TransSaltSpeco = 0: nOverspringInter2 = nOverspringInter2 + 1 'reset End If '(tot en met aantreffen Dubbele apostrof wordt woord oversprongen) 'Vierkante sluithaak (Inter3): If VortSpecoSluitHaak And TransSaltSpeco = 2 Then 'ivm SkipRektajKramp JesEind = False For i = 1 To 4 If EindHaakQuoteSpeco(i) = 2 Then JesEind = True Next i If JesEind Then AjnTransSalt = False: TransSaltSpeco = 0: nOverspringInter3 = nOverspringInter3 + 1 'reset End If '(tot en met aantreffen Vierkante sluithaak wordt woord oversprongen) 'Spitse sluithaak (Inter4): If VortSpecoSluitHaak And TransSaltSpeco = 3 Then 'ivm SkipAngulajKramp JesEind = False For i = 1 To 4 If EindHaakQuoteSpeco(i) = 3 Then JesEind = True Next i If JesEind Then AjnTransSalt = False: TransSaltSpeco = 0: nOverspringInter4 = nOverspringInter4 + 1 'reset End If '(tot en met aantreffen Spitse sluithaak wordt woord oversprongen) 'Gespecificeerd als specifieke verdere optie (Inter5): If SkipSpecifaOpcio Then '[20-5-08] If (VortSpecoEindQuote Or VortSpecoSluitHaak) And TransSaltSpeco = Inter5Speco Then 'ivm SkipSpecifaOpcio JesEind = False For i = 1 To 4 If Inter5Speco = EindHaakQuoteSpeco(i) Then JesEind = True If Inter5Speco = 13 And EindHaakQuoteSpeco(i) = 12 Then JesEind = True '(enkele verschillende BeginQuotes ... If Inter5Speco = 15 And EindHaakQuoteSpeco(i) = 14 Then JesEind = True '... corresponderen namelijk met ... If Inter5Speco = 16 And EindHaakQuoteSpeco(i) = 14 Then JesEind = True '... dezelfde EindQuotes) Next i If JesEind Then AjnTransSalt = False: TransSaltSpeco = 0: nOverspringInter5 = nOverspringInter5 + 1 'reset End If '(tot en met aantreffen specifieke Eind-quote of Sluit-haak wordt woord oversprongen) End If If TransSaltSpeco <> 0 Then 'sluithaak of eind-aanhalingsteken NOG NIET bereikt, op lopend tekst-traject voor Overspringen-van-woorden: If TransSaltSpeco = 10 Then nOverspringInter1 = nOverspringInter1 + 1 '(tot aantreffen Enkele apostrof wordt woord oversprongen) If nOverspringInter1 >= Overspring1Begin + nSpringAlert1 Then '[14-5-08] If MsgBox("Ekde komenca krampo/citilo estas jam " & nSpringAlert1 & " vortoj transsaltitaj !" _ & vbCr & "Chu daurigi la transsaltadon ?", vbYesNo) = vbNo Then AjnTransSalt = False TransSaltSpeco = 0 'reset Else 'If = vbYes Then nSpringAlert1 = nSpringAlert1 + nSpringAlert '[14-5-08] End If End If ElseIf TransSaltSpeco = 11 Then nOverspringInter2 = nOverspringInter2 + 1 '(tot aantreffen Dubbele apostrof wordt woord oversprongen) If nOverspringInter2 >= Overspring2Begin + nSpringAlert2 Then '[14-5-08] If MsgBox("Ekde komenca krampo/citilo estas jam " & nSpringAlert2 & " vortoj transsaltitaj !" _ & vbCr & "Chu daurigi la transsaltadon ?", vbYesNo) = vbNo Then AjnTransSalt = False TransSaltSpeco = 0 'reset Else 'If = vbYes Then nSpringAlert2 = nSpringAlert2 + nSpringAlert '[14-5-08] End If End If ElseIf TransSaltSpeco = 2 Then nOverspringInter3 = nOverspringInter3 + 1 '(tot aantreffen Vierkante sluithaak wordt woord oversprongen) If nOverspringInter3 >= Overspring3Begin + nSpringAlert3 Then '[14-5-08] If MsgBox("Ekde komenca krampo/citilo estas jam " & nSpringAlert3 & " vortoj transsaltitaj !" _ & vbCr & "Chu daurigi la transsaltadon ?", vbYesNo) = vbNo Then AjnTransSalt = False TransSaltSpeco = 0 'reset Else 'If = vbYes Then nSpringAlert3 = nSpringAlert3 + nSpringAlert '[14-5-08] End If End If ElseIf TransSaltSpeco = 3 Then nOverspringInter4 = nOverspringInter4 + 1 '(tot aantreffen Spitse sluithaak wordt woord oversprongen) If nOverspringInter4 >= Overspring4Begin + nSpringAlert4 Then '[14-5-08] If MsgBox("Ekde komenca krampo/citilo estas jam " & nSpringAlert4 & " vortoj transsaltitaj !" _ & vbCr & "Chu daurigi la transsaltadon ?", vbYesNo) = vbNo Then AjnTransSalt = False TransSaltSpeco = 0 'reset Else 'If = vbYes Then nSpringAlert4 = nSpringAlert4 + nSpringAlert '[14-5-08] End If End If ElseIf TransSaltSpeco = Inter5Speco Then nOverspringInter5 = nOverspringInter5 + 1 '(tot en met aantreffen specifieke Eind-quote of Sluit-haak wordt woord oversprongen) If nOverspringInter5 >= Overspring5Begin + nSpringAlert5 Then '[14-5-08] If MsgBox("Ekde komenca krampo/citilo estas jam " & nSpringAlert5 & " vortoj transsaltitaj !" _ & vbCr & "Chu daurigi la transsaltadon ?", vbYesNo) = vbNo Then AjnTransSalt = False TransSaltSpeco = 0 'reset Else 'If = vbYes Then nSpringAlert5 = nSpringAlert5 + nSpringAlert '[14-5-08] End If End If Else MsgBox "logical Error in AjnTransSalt-traject" End If End If GoTo 163 'overspring tekstwoord End If 'TUTMAJUSKLA woord evt. overspringen: zie hieronder, onder label 250; 'Cursief woord evt. overspringen: zie hieronder, boven label 241; 'een Enkel woord (tussen haken of quotes) evt. overspringen: If UnuopVort And LeestekenBijWoord Then If Not LosLeestekenWoord Then '(de UnuopVort-optie geldt NIET bij losstaande haken of quotes) 'het prefix "Ne" in onderstaande namen van tekens betekent "overspringen": 'Woord ingeklemd tussen enkele apostrofen evt. overspringen: If SkipApostr And VortSpecoBeginQuote And VortSpecoEindQuote Then '(Inter1): JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 10 Then JesBegin = True If EindHaakQuoteSpeco(i) = 10 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter1 = nOverspringInter1 + 1 GoTo 163 End If End If 'Woord ingeklemd tussen dubbele apostrofen evt. overspringen: If SkipDuoblApostr And VortSpecoBeginQuote And VortSpecoEindQuote Then '(Inter2): JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 11 Then JesBegin = True If EindHaakQuoteSpeco(i) = 11 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter2 = nOverspringInter2 + 1 GoTo 163 End If End If 'Woord ingeklemd tussen vierkante haken evt. overspringen: If SkipRektajKramp And VortSpecoBeginHaak And VortSpecoSluitHaak Then '(Inter3): JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 2 Then JesBegin = True If EindHaakQuoteSpeco(i) = 2 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter3 = nOverspringInter3 + 1 GoTo 163 End If End If 'Woord ingeklemd tussen spitse haken evt. overspringen: If SkipAngulajKramp And VortSpecoBeginHaak And VortSpecoSluitHaak Then '(Inter4): JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 3 Then JesBegin = True If EindHaakQuoteSpeco(i) = 3 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter4 = nOverspringInter4 + 1 GoTo 163 End If End If 'Woord ingeklemd tussen het als Optie (Inter5) gespecificeerde tekenpaar: If SkipSpecifaOpcio Then If (VortSpecoBeginHaak And VortSpecoSluitHaak) Or _ (VortSpecoBeginQuote And VortSpecoEindQuote) Then '(Inter5): JesBegin = False: JesEind = False For i = 1 To 4 If Inter5Speco = BeginHaakQuoteSpeco(i) Then JesBegin = True If Inter5Speco = 19 And BeginHaakQuoteSpeco(i) = 15 Then JesBegin = True '(twee verschillende EindQuotes ... [19-5-08] '... corresponderen namelijk met dezelfde BeginQuote) If Inter5Speco = EindHaakQuoteSpeco(i) Then JesEind = True If Inter5Speco = 13 And EindHaakQuoteSpeco(i) = 12 Then JesEind = True '(enkele verschillende BeginQuotes ... If Inter5Speco = 15 And EindHaakQuoteSpeco(i) = 14 Then JesEind = True '... corresponderen namelijk met ... If Inter5Speco = 16 And EindHaakQuoteSpeco(i) = 14 Then JesEind = True '... dezelfde EindQuote) Next i If JesBegin And JesEind Then nOverspringInter5 = nOverspringInter5 + 1 GoTo 163 End If End If End If End If End If If AjnanTekst And Not AjnTransSalt Then 'opzoek naar openingshaak of beginaanhalingsteken, 'als BEGIN van evt. tekst-traject voor Overspringen-van-woorden: 'de hieronder gehanteerde volgorde is uitgebalanceerd [19-4-08]: 'Spitse openingshaak (Inter4): If SkipAngulajKramp And VortSpecoBeginHaak Then JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 3 Then JesBegin = True If EindHaakQuoteSpeco(i) = 3 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter4 = nOverspringInter4 + 1 GoTo 163 ElseIf JesBegin Then AjnTransSalt = True TransSaltSpeco = 3 Overspring4Begin = nOverspringInter4 nOverspringInter4 = nOverspringInter4 + 1 '(vanaf aantreffen Spitse openingshaak wordt woord oversprongen) nSpringAlert4 = nSpringAlert '[14-5-08] GoTo 163 End If End If 'Vierkante openingshaak (Inter3): If SkipRektajKramp And VortSpecoBeginHaak Then JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 2 Then JesBegin = True If EindHaakQuoteSpeco(i) = 2 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter3 = nOverspringInter3 + 1 GoTo 163 ElseIf JesBegin Then AjnTransSalt = True TransSaltSpeco = 2 Overspring3Begin = nOverspringInter3 nOverspringInter3 = nOverspringInter3 + 1 '(vanaf aantreffen Vierkante openingshaak wordt woord oversprongen) nSpringAlert3 = nSpringAlert '[14-5-08] GoTo 163 End If End If 'Teken gespecificeerd als Begin-quote of Openings-haak (Inter5): If SkipSpecifaOpcio And (VortSpecoBeginHaak Or VortSpecoBeginQuote) Then JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = Inter5Speco Then JesBegin = True If EindHaakQuoteSpeco(i) = Inter5Speco Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter5 = nOverspringInter5 + 1 GoTo 163 ElseIf JesBegin Then AjnTransSalt = True TransSaltSpeco = Inter5Speco Overspring5Begin = nOverspringInter5 nOverspringInter5 = nOverspringInter5 + 1 '(vanaf aantreffen Begin-quote of Openings-haak wordt woord oversprongen) nSpringAlert5 = nSpringAlert '[14-5-08] GoTo 163 End If End If 'Dubbele apostrof (Inter2): If SkipDuoblApostr And VortSpecoBeginQuote Then JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 11 Then JesBegin = True If EindHaakQuoteSpeco(i) = 11 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter2 = nOverspringInter2 + 1 GoTo 163 ElseIf JesBegin Then AjnTransSalt = True TransSaltSpeco = 11 Overspring2Begin = nOverspringInter2 nOverspringInter2 = nOverspringInter2 + 1 '(vanaf aantreffen Dubbele apostrof wordt woord oversprongen) nSpringAlert2 = nSpringAlert '[14-5-08] GoTo 163 End If End If 'Enkele apostrof (Inter1):: If SkipApostr And VortSpecoBeginQuote Then JesBegin = False: JesEind = False For i = 1 To 4 If BeginHaakQuoteSpeco(i) = 10 Then JesBegin = True If EindHaakQuoteSpeco(i) = 10 Then JesEind = True Next i If JesBegin And JesEind Then nOverspringInter1 = nOverspringInter1 + 1 GoTo 163 ElseIf JesBegin Then AjnTransSalt = True TransSaltSpeco = 10 Overspring1Begin = nOverspringInter1 nOverspringInter1 = nOverspringInter1 + 1 '(vanaf aantreffen Enkele apostrof wordt woord oversprongen) nSpringAlert1 = nSpringAlert '[14-5-08] GoTo 163 End If End If End If If LosLeestekenWoord Then GoTo 290 243: 'Cursief woord evt. overspringen: If SkipKursiv And Selection.Font.Italic Then nOverspringCursief = nOverspringCursief + 1 GoTo 163 End If 241: 'test op getallen, datums, woorden die beginnen met cijfer(s): '[versoepelde beregeling vanaf 26-4-2005] If Cijfer(ChBegin) Then GoTo 280 'begint met cijfer 'If Cijfer(ChEnd): 'eindigen op cijfer(s) mag wel (bijv. Formula-1, Soyuz-2, Windows-2000) en... ' ...er mogen ook cijfers middenin het woord zitten (bijv. vak-2c) 242: ' r e t a d r e s o j hier uitfilteren: '[25-2-2008] If Lengte >= 10 Then 'de meeste website-namen en email-adressen zijn minstens 10 tekens lang k = InStr(6, TekstWoord, "@") 'ivm email-adressen '[12-3-2008] If k <> 0 Then i = k Else i = 0 k = InStr(i + 6, TekstWoord, ".") 'de domain extension, die een lengte heeft van max. 4 en minimaal 2, ... If k = 0 Then GoTo 244 'er moet in ieder geval een punt in staan voor de domain extension ter rechterzijde,... If k >= Lengte - 4 And k < Lengte - 1 Then '...die een lengte heeft van minimaal 2 en maximaal 4 tekens; 'verder moet de domain extensie met een Letter (geen cijfer) beginnen, en er mag GEEN puntenreeks (ook geen tripunkto aan vooraf gaan): If Letter(Mid(TekstWoord, k + 1, 1)) And (Not (Mid(TekstWoord, k - 1, 1) = "." Or Mid(TekstWoord, k - 1, 1) = ChrW(8230))) Then 'Tekstwoord is een retadreso (website-naam of email-adres): GoTo 285 End If Else m = InStr(11, TekstWoord, "/") 'hou ook rekening met een uitgebreide websitenaam, waar een slash een rechter extra deel inleidt If m = 0 Then GoTo 244 'geen retadreso k = InStr(m - 4, TekstWoord, ".") 'aanname: de aan de slash voorafgaande domain extension is 2 of 3 tekens lang (geen 4) If k >= m - 1 Then GoTo 244 'geen retadreso (slash wordt niet voorafgegaan door domain extension cq de daaraan voorafgaande punt) 'Tekstwoord is een retadreso: GoTo 285 End If End If 244: 'geen retadreso 'Woord met (hoofd-)LETTER(s): ' MetEigennaamBezig = False '(TaalWoord als default) Wsh = 2 'TaalwoordLijst staat in Worksheet 2 Rkolom = 12 'Taalwoordlijst beslaat kolommen 2 t/m 12 'Haal evt. Wilde Hoofdletters Weg uit het tekstwoord: '[2-3-08: voorlopig nog afgeklemd] '(Wilde Hoofdletters zijn eenzame hoofdletters middenin een woord, of bijv. 2 hoofdletters vooraan en daarna kleine letters) 'If TekstWoord = "a.K." Or TekstWoord = "p.K." Then GoTo 248 '(deze twee Esp.-afkortingen zijn uitzonderingen: GEEN wilde hoofdletters) 'TekstWoord = WildeHoofdlettersWeg(TekstWoord, wildehoofdlweggehaald) '(als eerste letter hoofdletter is blijft die altijd staan) 'If wildehoofdlweggehaald Then ' 'ook in de brontekstfile het woord overschrijven met het gecorrigeerde TekstWoord: ' Selection.Range.HighlightColorIndex = wdGray25 'markeer gecorrigeerd woord met LICHTGRIJS kleurtje... ' Selection.TypeText Text:=TekstWoord '...(de kleuropdracht moet VOOR de TypeText-opdracht komen!) ' nWoordWildeHoofdlettersWeg = nWoordWildeHoofdlettersWeg + 1 'End If 248: UnmarkedCap = False '(default) If Hoofdletter(ChBegin) = False Then MajusklaVort = False '[24-4-08] 'MsgBox "woord ZONDER hoofdletter, dus wschl Taalwoord" GoTo 271 End If 250: 'Woord met BEGIN-HOOFDLETTER: MajusklaVort = True '[24-4-08] 'TUTMAJUSKLA woord (ACRONYM, woord in Titels of Tussenkoppen, of elders in tekst, ter benadrukking) evt. overspringen: 'het gaat strikt genomen niet om een woord dat Geheel-Uit-Hoofdletters bestaat, maar om ... ' ...een woord waarin GEEN kleine letters voorkomen, want er mogen behalve Hoofdletters ... ' ...wel cijfers, hyphens of apostrofen in voorkomen (cijfers niet op positie 1): If GeenKleineLetters(TekstWoord) And SkipTutmajuskl Then nOverspringTutmajuskl = nOverspringTutmajuskl + 1 GoTo 163 End If 'UNMARKED Capitalization = aan ZINS-BEGIN en in enkele andere gevallen zoals Quotes [zie ook onder label 235]: If jTekstWoord = 1 Or MogelijkBeginZinsQuotering Then GoTo 255 'speciale behandeling voor Unmarked Caps. 'Capitalization van 2e woord van zin kan wijzen op KOPREGEL met Title Case (elk woord met hoofdletter) of Tutmajuskla in z'n geheel [24-4-08]: If jTekstWoord = 2 Then 'check of dit echt een Kopregel is: AlineaNummer = CDec(Left(textAlineaZinsnummer, InStr(2, textAlineaZinsnummer, "-") - 1)) '(een Kopregel is technisch gezien een aparte Alinea) With WstatWordtoExcel.worksheets(5) For i = iKopregelLijst To 10000 If .Cells(i, 16) = AlineaNummer Then 'Zin komt voor in KopregelLijst, en geldt als Kopregel tenzij: If nZinsLengte > 10 Then GoTo 25009 'Zin te lang voor Kopregel End If If i > i1KopregelLijst + 1 Then '(komt neer op i > 3 wanneer de KopregelLijst begint op rij 2) If .Cells(i, 20) + .Cells(i - 1, 20) + .Cells(i - 2, 20) + .Cells(i + 1, 20) + .Cells(i + 2, 20) < 24 Then GoTo 25009 'omgeving maakt Zin NIET tot Kopregel (meer dan 3 kopregel-achtige zinnen achter elkaar) End If End If GoTo 25008 'Zin is KOPREGEL ElseIf .Cells(i, 16) > AlineaNummer Then GoTo 25009 'Zin komt NIET voor in KopregelLijst ElseIf .Cells(i, 16) = 0 Then '(aangenomen wordt dat een tekstfile niet meer dan 10.000 kopregels heeft) iKopregelLijst = 10000 '(zorgt voor shortcut bij volgende raadpleging) GoTo 25009 'einde lijst bereikt End If Next i End With 25009: 'MsgBox "zin " & textAlineaZinsnummer & " is GEEN kopregel" GoTo 25010 25008: 'MsgBox "zin " & textAlineaZinsnummer & " is KOPREGEL" iKopregelLijst = i + 1 '(zet beginpositie voor volgende raadpleging) End If 25010: 'einde van check of zin met Capitalization van 2e woord Kopregel is [24-4-08] 'MARKED Capitalization = midden in zin (dus NIET aan begin van zin of aan begin van Quote); 'de hoofdletter-aan-het-begin-van-een-woord geeft dan direct uitsluitsel over het Eigennaam zijn van dat woord: 251: 'Kijk of de Marked Cap al in de tekst-EigennaamLijst voorkomt, en zo niet, bepaal dan alvast de iInsertPos '(de Eigennaamlijst wordt volgens de gewone alfabetische Excel-SORTERING opgebouwd): MetEigennaamBezig = True Wsh = 3 'EigennaamLijst staat in Worksheet 3 Rkolom = 9 'EigennaamLijst beslaat kolommen 2 t/m 9 If WstatnLijstEigennaam = 0 Then '(bij eerste Eigennaam is EigennaamLijst is nog leeg) If UnmarkedCap Then GoTo 712 'MsgBox "MarkedCap stond NIET in tekst-EigennaamLijst; er zal nu gecheckt worden op Eigennaam-Boek en DICT" InsertPos = InsertPosEigennaam GoTo 720 End If GoTo 70001 'Eigennaam-Ingang voor "QUASI-SUBROUTINE BINAIR ZOEK- en INSERTIE" [aangeroepen onder label 271] 253: 'Eigennaam matcht met een Eigennaam uit de lijst (AbsFreq ophogen): .worksheets(Wsh).Cells(MatchPos, 3) = .worksheets(Wsh).Cells(MatchPos, 3) + 1 'Text-Coherence stack van Propraj Nomoj bijhouden [toevoeging 27-3-08]: nPropNamSequence = nPropNamSequence + 1 'nPropNamSequence fungeert als Stack Pointer (meest recente entry, onderste in kolom) If nPropNamSequence = 62001 Then 'bij bereiken van deze grenswaarde wordt de Stack ingekrompen tot de 25 meest recente entries (Excel-rijen 61976 t/m 62000) For kk = 1 To 25 PropNamAuxNum(kk) = .worksheets(Wsh).Cells(61975 + kk, 27) 'de Text-Coherence stack staat in Excel-kolom 27 (AA) en 28 (AB) PropNamAuxWoord(kk) = .worksheets(Wsh).Cells(61975 + kk, 28) Next kk .worksheets(Wsh).Columns(27).ClearContents .worksheets(Wsh).Columns(28).ClearContents For kk = 1 To 25 .worksheets(Wsh).Cells(1 + kk, 27) = PropNamAuxNum(kk) 'de eerste 25 stackposities komen in rij 2 t/m 26 van Excel-kolom 27 en 28 .worksheets(Wsh).Cells(1 + kk, 28) = PropNamAuxWoord(kk) Next kk nPropNamSequence = 27 'nPropNamSequence voor aktuele toevoeging na inkrimping Stack tot 25 entries (Excel-rijen 2 t/m 26) End If .worksheets(Wsh).Cells(nPropNamSequence, 27) = TekstWoordNummer 'aktuele toevoeging aan de Text-Coherence stack [27-3-08]: .worksheets(Wsh).Cells(nPropNamSequence, 28) = TekstWoord '[einde toevoeging 27-3-08] 'Verder bijwerken van (alfabetische) EigennaamLijst: If Not UnmarkedCap Then .worksheets(Wsh).Cells(MatchPos, 6) = "" 'bij MarkedCap (= 'Not UnmarkedCap') EBO...-AmbiguMark weghalen [4-3-08] 'Indien de EigennaamLijst-entry gemarkeerd is met "EOf", dan wordt deze (UnmarkedCap-)markering opgewaardeerd tot "E": '[toevoeging 23-1-08] If .worksheets(Wsh).Cells(MatchPos, 4) = "EOf" Then 'Ga naar de eerdere Unmarked Cap occurrence van ditzelfde woord en verwijder de rozeroodkleuring daarvan: iPosMarkedOccurrence = Selection.Characters(1).Start Selection.Collapse direction:=wdCollapseStart Selection.Find.Text = TekstWoord: Selection.Find.MatchCase = True: Selection.Find.MatchWholeWord = True Selection.Find.Forward = False: Selection.Find.Wrap = wdFindStop: Selection.Find.Execute iPosUnmarkedOccurrence = Selection.Characters(1).Start TekstAfstand = iPosMarkedOccurrence - iPosUnmarkedOccurrence 'If TekstAfstand > TekstAfstandsBovengrens Then GoTo 256 '[*evt. kan een TekstAfstandsBovengrens voor de opwaardering worden ingesteld] If Selection.Text = TekstWoord Then Selection.Font.Color = wdAuto 'de rozeroodkleuring wordt verwijderd VortSpecMarko = "E" '"EOf" wordt overschreven... .worksheets(Wsh).Cells(MatchPos, 4) = VortSpecMarko 'de EigennaamLijst wordt ge-update nEOfUpgrade = nEOfUpgrade + 1 'alleen ter controle (uitvoer samenvattende gegevens bij eindafhandeling) nHalfFoutOfFremdWoord = nHalfFoutOfFremdWoord - 1 '(corrigeer Telling van deze 'Halffoute' woorden) Else 'indien hoe dan ook het Find-resultaat toch negatief was: nEOfUpgradeFailed = nEOfUpgradeFailed + 1 End If 256: Selection.MoveStart , TekstAfstand 'weer terug naar de huidige Marked Cap occurrence Selection.MoveEnd , Lengte 'van Tekstwoord 'hiermee is de huidige Selection weer hersteld End If '[eind toevoeging 23-1-08] 258: WstatnEigennaam = WstatnEigennaam + 1 GoTo 160 'einde behandeling woorden met Hoofdletters 255: 'UNMARKED CAP: 'Speciale behandeling voor Woord met HOOFDLETTER aan BEGIN VAN ZIN, of aan Begin van Quote en dergelijke: UnmarkedCap = True 'zgn. Unmarked Capitalization 'Hieronder wordt verstaan een hoofdletter-aan-het-begin-van-een-woord, die op zichzelf geen uitsluitsel geeft 'over het al dan niet eigennaam zijn van dat woord, omdat het woord toevallig aan het begin van een zin, 'na een openingshaak, aan het begin van een quote/dialoogwending staat, of een geheel uit hoofdletters bestaand 'woord is in een titel (ook zgn. Title Case: een titel waarin elk inhoudswoord met een hoofdletter begint). WstatnUnmarkedCap = WstatnUnmarkedCap + 1 ' 'BEHANDELING VAN EEN GEWOON TAALWOORD of van een UnmarkedCap woord: 271: If WstatnLijstWoord = 0 Then '(bij eerste Taalwoord is TaalwoordLijst nog leeg) InsertPos = 2 '[28-3-08] GoTo 701 '[28-3-08] End If 'Kijk of TekstWoord al in 1 van de tekst-Woordlijsten (in eerste instantie in de tekst-TaalwoordLijst, in tweede instantie in... '...de tekst-EigennaamLijst [zie boven label 253]) voorkomt, en bepaal de Match- of (eventuele) Insert-Positie in die Lijst: '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------- GoTo 70000 'QUASI-SUBROUTINE voor (Snelheidsverhogend) BINAIR ZOEK- en INSERTIE-proces in de tekst-Lijsten: '---------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'bij een Match in tekst-TaalwoordenLijst of tekst-EigennaamLijst wordt naar resp. label 278 of label 253 gesprongen; 'bij GEEN Match in tekst-TaalwoordenLijst of tekst-EigennaamLijst: 700: If EBOinTaalwoordLijst Then GoTo 277 '(bijzonder geval [3-2-2008, "toekomstige Verfijning EBO-gevallen"] 701: 'Als UnmarkedCap tekstwoord niet stond in de tekst-Taalwoordenlijst , kijk dan of het in de tekst-Eigennaamlijst staat: If UnmarkedCap And Not MetEigennaamBezig Then 'MsgBox "UnmarkedCap stond NIET in Taalwoordenlijst; nu ook EigennaamLijst checken" InsertPosTaalwoord = InsertPos GoTo 251 'indien NIET als Taalwoord in de tekst-Taalwoordenlijst, kijk dan of als Eigennnaam in de tekst-Eigennaamlijst End If 'Als UnmarkedCap tekstwoord OOK NIET in de tekst-Eigennaamlijst: If UnmarkedCap And MetEigennaamBezig Then 'MsgBox "UnmarkedCap stond OOK NIET in EigennaamLijst; nu checken op DICT en Eigennaam-BOEK" InsertPosEigennaam = InsertPos GoTo 712 End If 'Indien GEEN UnmarkedCap: If MetEigennaamBezig Then 'MsgBox "MarkedCap stond NIET in tekst-EigennaamLijst; er zal nu gecheckt worden op Eigennaam-Boek en DICT" '[21-1-2008] GoTo 720 Else 'BIJ GEWOON TAALWOORD: 'MsgBox "Taalwoord stond NIET in Taalwoordlijst;" & vbCr & _ "er zal nu gecheckt worden op Dictionary" GoTo 720 End If 712: 'UNMARKED CAP: 'UnmarkedCap staat NIET in tekst-TaalwoordLijst en ook NIET in tekst-EigennaamLijst: 'Check nu eerst op EigennaamBOEK, daarna pas op Dictionaries (denk aan bijv. "Zapatero")... '...althans indien woordlengte >= 3. Op deze wijze wordt voorkomen dat een formeel correct maar... '...semantisch onzinnige Kunmeto (bijv. "zap-at-er-o") voorrang krijgt boven een bestaande Eigennaam. 'Dit mechanisme is mede ingebouwd in de Procedure 'TekstVortKontrol' [15-1-08]. If Not UnmarkedCap Then MsgBox "Erarkodo 80712a": If Not MetEigennaamBezig Then MsgBox "Erarkodo 80712b" 'MsgBox "UnmarkedCap stond NIET in Taalwoordenlijst, en ook NIET in EigennaamLijst;" & vbCr & _ "er zal nu gecheckt worden op EigennaamBOEK en Dictionary" '-------------------------------------------------------------------------------------------------------------------------------------------------- Call TekstVortKontrol(TekstWoord, VortSpecMarko, synmark, genvoc, SamenstellingOrHyphenatedIndicator, struct, nstruct, Ambigumark, iPosOptionalHyphen) '[12-12-08] '-------------------------------------------------------------------------------------------------------------------------------------------------- nOproepCheckEspWord = nOproepCheckEspWord + 1 'alleen ter controle (uitvoer samenvattende gegevens bij eindafhandeling) 'UnmarkedCap dat NIET in Taalwoordenlijst en ook NIET in EigennaamLijst stond,... '...maar misschien WEL in EigennaamBOEK: If Left(VortSpecMarko, 2) = "EB" Then 'dus: indien "EB", "EBON", "EBOA", etc: 'MsgBox "blijkens EigennaamBOEK bestaat UnmarkedCap als Eigennaam;" & vbCr & _ "nu volgt alsnog plaatsing in de EigennaamLijst" MetEigennaamBezig = True InsertPos = InsertPosEigennaam '*mogelijk overbodig GoTo 275 Else 'UnmarkedCap staat NIET in EigennaamBOEK, maar is ook tegen (Taal-)Dictionaries gecheckt: 'Het niet in het EigennaamBOEK staan betekent nog niet dat het UnmarkedCap-woord geen Eigennaam zou kunnen zijn: 'er bestaat immers geen EigennaamBOEK dat alle Eigennamen van de wereld bevat; het kan dus een onbekende Eigennaam zijn; 'maar indien de (Taal-)Dictionary-check positief uitvalt, als het dus een correct Taalwoord of Samenstelling is, krijgt dat voorrang en komt het dus ... 'in de tekst-TaalwoordLijst (met gewone VortSpecMarko, bijv. N, A, p, k, etc). If VortSpecMarko <> "f" Then 'MsgBox "blijkens Dict is UnmarkedCap een geldig Taalwoord of Samenstelling; nu volgt plaatsing in de TaalwoordLijst" MetEigennaamBezig = False Wsh = 2 'niet overbodig InsertPos = InsertPosTaalwoord TekstWoord = BeginHoofdletterWeg(TekstWoord) 'Indien de DICT-check geresulteerd heeft in een fout of niet bestaand Taalwoord krijgt de onbekende Eigennaam de markering "EOf' en komt... 'in de tekst-EigennaamLijst te staan: Else 'If VortSpecMarko = "f" Then 'MsgBox "blijkens Dict is UnmarkedCap GEEN correct Taalwoord, nu volgt plaatsing in de EigennaamLijst" MetEigennaamBezig = True Wsh = 3 VortSpecMarko = "EOf" InsertPos = InsertPosEigennaam nEOf = nEOf + 1 'alleen ter controle (uitvoer samenvattende gegevens bij eindafhandeling) End If GoTo 275 End If 720: 'MARKED CAP of GEWOON TEKSTWOORD: '----------------------------------------------------------------------------------------------------------------------------------------------------- Call TekstVortKontrol(TekstWoord, VortSpecMarko, synmark, genvoc, SamenstellingOrHyphenatedIndicator, struct, nstruct, Ambigumark, iPosOptionalHyphen) '[12-12-2008] '----------------------------------------------------------------------------------------------------------------------------------------------------- nOproepCheckEspWord = nOproepCheckEspWord + 1 'alleen ter controle (uitvoer samenvattende gegevens bij eindafhandeling) If MetEigennaamBezig Then 'Marked Cap is een Hoofdletterwoord middenin een zin (i.t.t. Unmarked Cap aan zins-BEGIN) 'Marked Cap (waarschijnlijk Eigennaam): If Left(VortSpecMarko, 2) = "EB" Then 'Marked Cap staat in EigennaamBoek; het zal in EigennaamLijst komen met VortSpecMarko beginnend met "EB", en mogelijk langer: ' "EB&..." ingeval van een Asimilita Eigennaam (op -o, en evt. accusatief of meervoud): EB&N, EB&Nj, EB&N4, EB&N4j ; ' "EBO..." ingeval van een Eigennaam die ook Taalwoord kan zijn: EBON (bijv. "Zap-at-er-o"), EBON4 (bijv. "Le-on"), EBOA (bijv. "Le-a"), etc; ' [bij dergelijke ambigue woorden staat deze VortSpecMarko reeds in het EigennnaamBoek geregistreerd] ElseIf VortSpecMarko = "f" Then 'Marked Cap is in ieder geval geen correct taalwoord; het zal in EigennaamLijst komen met VortSpecMarko = "E" VortSpecMarko = "E" Else 'Marked Cap is (ook) een taalwoord of zou een samenstelling kunnen zijn; het zal in EigennaamLijst komen met ... '...extra aanduiding als bijv. ON, OA, Op, Ok etc. (waarbij N, A, p, k, etc de VortSpecmarko van het mogelijke Taalwoord is) VortSpecMarko = "EO" & VortSpecMarko 'dus bijv.: "EON", "EOA", "EOp", "EOk" etc. End If Else 'GEWOON TEKSTWOORD, zonder hoofdletter: If VortSpecMarko = "E" Then MsgBox "onmogelijke uitkomst: woord zonder hoofdletter kan NOOIT op EigennaamBoek gecheckt ziijn" End If End If 'In bovenstaande oproepen van de Procedure 'TekstVortKontrol' is de 1e parameter ALLEEN invoerparameter; de overige zes zijn uitvoerparameters; 'VortSpecMarko geeft de woordsoort (incl. het fout zijn) van een Taalwoord door; via de parameter 'struct' wordt de MORFEEM-structuur van een ingevoerd... '...en correct bevonden Taalwoord doorgegeven, incl. de (Voorkeurs-)Splitsingen van een evt. WoordSamenstelling. 'DAT het ingevoerde Taalwoord een (niet in de Dictionaries staande maar formeel wel correcte) WoordSamenstelling is, blijkt uit het verschijnen van een "s" in de... 'parameter 'SamenstellingOrHyphenatedIndicator' (ook bij unhyphenated tekstwoorden!). 275: If MetEigennaamBezig Then 'Eigennaam wordt nu (op vrijgemaakte Insert-plek) toegevoegd: If Not WstatnLijstEigennaam = 0 Then If Not InsertPos = IendEigennaam + 1 Then '[insert onderaan lijst is onnodig en bovendien schadelijk (duwt evt. verdere cellen rechts opzij)] Rkolom = 9 .worksheets(Wsh).Range(.worksheets(Wsh).Cells(InsertPos, 2), .worksheets(Wsh).Cells(InsertPos, Rkolom)).Insert '[15-1-08: op InsertPos regel invoegen] End If IendEigennaam = IendEigennaam + 1 'de lengte van de EigennaamLijst (en dus zijn eindpositie) neemt door Insertie toe met 1 End If WstatnLijstEigennaam = WstatnLijstEigennaam + 1 Else 'bij Taalwoord: If OverschrijvingNulEntry Then GoTo 273 '[4-3-08] 'Tekstwoord wordt nu (op vrijgemaakte Insert-plek) toegevoegd: If Not WstatnLijstWoord = 0 Then If Not InsertPos = Iend + 1 Then '[insert onderaan lijst is onnodig en bovendien schadelijk (duwt evt. verdere cellen rechts opzij)] Rkolom = 12 .worksheets(Wsh).Range(.worksheets(Wsh).Cells(InsertPos, 2), .worksheets(Wsh).Cells(InsertPos, Rkolom)).Insert '[15-1-08: op InsertPos regel invoegen (vroeger gebeurde dit bij label 77151 of 77152) ] End If Iend = Iend + 1 'de lengte van de TaalWoordLijst (en dus zijn eindpositie) neemt door Insertie toe met 1 End If WstatnLijstWoord = WstatnLijstWoord + 1 End If .worksheets(Wsh).Cells(InsertPos, 2) = TekstWoord '.Worksheets(Wsh).Cells(InsertPos, 2).Select '[dient slechts voor TYDELYKE VISUALISERING van de Excel-sheet; 30-10-06] If Right(TekstWoord, 1) = "e" Then 'uitzonderings-behandeling voor de Esp. woorden 'false' en 'true' : If TekstWoord = "false" Or TekstWoord = "true" _ Or TekstWoord = "False" Or TekstWoord = "True" Then 'deze twee (Esperanto) woorden leiden in Excel woordenlijsten tot Boolean interpretatie, 'en worden om dit te voorkomen voorzien van een aansluitende spatie: .worksheets(Wsh).Cells(InsertPos, 2) = TekstWoord & " " End If End If 273: .worksheets(Wsh).Cells(InsertPos, 3) = 1 'frequentie=1 If MetEigennaamBezig Then 'Text-Coherence stack van Propraj Nomoj bijhouden [toevoeging 27-3-08]: If VortSpecMarko = "EOf" Then GoTo 274 'skip bij Unmarked Cap (want dat kan een ook fout-geschreven taalwoord zijn) nPropNamSequence = nPropNamSequence + 1 'nPropNamSequence fungeert als Stack Pointer (meest recente entry, onderste in kolom) If nPropNamSequence = 62001 Then 'bij bereiken van deze grenswaarde wordt de Stack ingekrompen tot de 25 meest recente entries (Excel-rijen): For kk = 1 To 25 '61976 To 62000 PropNamAuxNum(kk) = .worksheets(Wsh).Cells(61975 + kk, 27) 'de Text-Coherence stack staat in Excel-kolom 27 (AA) en 28 (AB) PropNamAuxWoord(kk) = .worksheets(Wsh).Cells(61975 + kk, 28) Next kk .worksheets(Wsh).Columns(27).ClearContents .worksheets(Wsh).Columns(28).ClearContents For kk = 1 To 25 .worksheets(Wsh).Cells(1 + kk, 27) = PropNamAuxNum(kk) 'de eerste 25 stackposities komen in rij 2 t/m 26 van Excel-kolom 27 en 28 .worksheets(Wsh).Cells(1 + kk, 28) = PropNamAuxWoord(kk) Next kk nPropNamSequence = 27 'nPropNamSequence voor aktuele toevoeging na inkrimping Stack tot 25 entries (Excel-rijen 2 t/m 26) End If .worksheets(Wsh).Cells(nPropNamSequence, 27) = TekstWoordNummer 'aktuele toevoeging aan de Text-Coherence stack [27-3-08]: .worksheets(Wsh).Cells(nPropNamSequence, 28) = TekstWoord '[einde toevoeging 27-3-08] 274: 'Verder invullen van (alfabetische) EigennaamLijst: .worksheets(Wsh).Cells(InsertPos, 4) = VortSpecMarko 'kan hier zijn: "E", "EO..", "EOf", "EB", "EB&..." .worksheets(Wsh).Cells(InsertPos, 5) = synmark 'Asimil-Marko ( 1 = Asimilita Propra Nomo) '.Worksheets(Wsh).Cells(InsertPos, 6) = 'voor Ambigumark gereserveerd [zie hieronder] .worksheets(Wsh).Cells(InsertPos, 7) = genvoc 'Propra-Nomo-Kategorio '.Worksheets(Wsh).Cells(InsertPos, 8) = 'gereserveerd voor evt. toekomstig gebruik If Left(VortSpecMarko, 3) = "EB&" Then .worksheets(Wsh).Cells(InsertPos, 9) = struct(1) 'morfeemstructuur (alleen bij Asimilita Propra Nomo) WstatnEigennaam = WstatnEigennaam + 1 If Not UnmarkedCap Then '[conditie 'Marked Cap' (= 'Not UnmarkedCap') toegevoegd 4-3-08] struct(1) = "" '[noodzakelijke correctie, 31-3-08] GoTo 160 End If If Ambigumark = "" Then GoTo 160 276: 'Bij een Eigennaam met 'Ambigumark' <> "" wordt de ambigue woordvorm niet alleen in de Eigennaamlijst gezet: .worksheets(Wsh).Cells(InsertPos, 6) = Ambigumark 'EBO... (bijv. "EBON", "EBON4", "EBONj", "EBOA", ...) '... maar bovendienwordt uit voorzorg alvast een 'Nul-entry' in de Taalwoordlijst geplaatst: EBOinTaalwoordLijst = True MetEigennaamBezig = False Nulvector = False Wsh = 2 Rkolom = 12 GoTo 70000 'binair doorzoeken Taalwoordlijst (misschien staat er al een 'Nul-entry' van dezelfde woordvorm in!) 277: 'De ambigue woordvorm wordt nu (op vrijgemaakte Insert-plek) toegevoegd '[3-2-2008, "toekomstige Verfijning EBO-gevallen"]: If Not WstatnLijstWoord = 0 Then Wsh = 2 If Not InsertPos = Iend + 1 Then '[insert onderaan lijst is onnodig en bovendien schadelijk (duwt evt. verdere cellen rechts opzij)] Rkolom = 12 .worksheets(Wsh).Range(.worksheets(Wsh).Cells(InsertPos, 2), .worksheets(Wsh).Cells(InsertPos, Rkolom)).Insert '[15-1-08: op InsertPos regel invoegen (vroeger gebeurde dit bij label 77151 of 77152) ] End If Iend = Iend + 1 'de lengte van de TaalWoordLijst (en dus zijn eindpositie) neemt door Insertie toe met 1 Else 'If WstatnLijstWoord = 0 (bij nog lege lijst): InsertPos = 2 '[3-3-08] End If .worksheets(Wsh).Cells(InsertPos, 2) = BeginHoofdletterWeg(TekstWoord) 'zonder hoofdletter If Right(TekstWoord, 1) = "e" Then 'uitzonderings-behandeling voor de Esp. woorden 'false' en 'true' : If TekstWoord = "false" Or TekstWoord = "true" _ Or TekstWoord = "False" Or TekstWoord = "True" Then 'deze twee (Esperanto) woorden leiden in Excel woordenlijsten tot Boolean interpretatie, 'en worden om dit te voorkomen voorzien van een aansluitende spatie: .worksheets(Wsh).Cells(InsertPos, 2) = TekstWoord & " " End If End If .worksheets(Wsh).Cells(InsertPos, 3) = 0 'aantal ( = nul voor Nul-Entry!) .worksheets(Wsh).Cells(InsertPos, 6) = Ambigumark WstatnLijstWoord = WstatnLijstWoord + 1 WstatnNulEntry = WstatnNulEntry + 1 'het aantal Nul-Entries wordt bijgehouden (om dit af te kunnen trekken van aantal Gewone TaalwoordLijst-entries) Else 'bij Gewoon Taalwoord: .worksheets(Wsh).Cells(InsertPos, 4) = VortSpecMarko 'woordsoortteken komt in een aparte kolom .worksheets(Wsh).Cells(InsertPos, 5) = synmark 'SynMark-teken komt in een aparte kolom .worksheets(Wsh).Cells(InsertPos, 7) = genvoc 'GenVoc-teken komt in een aparte kolom '[22-10-08, verplaatst] If VortSpecMarko = "f" Then 'Behandeling Foute woorden: 'Speciale check of dit foute woord misschien een geadjectiveerde Propra Nomo is [29-3-08]: If Right(TekstWoord, 1) = "a" Or Right(TekstWoord, 2) = "an" Or Right(TekstWoord, 2) = "aj" Or Right(TekstWoord, 3) = "ajn" Then i = InStr(1, StrReverse(TekstWoord), "a") UitgangAdjectief = Right(TekstWoord, i) StamAdjectief = Left(TekstWoord, Lengte - i) 'Doorzoek Text-Coherence stack van Propraj Nomoj, ... For i = 0 To nPropNamSequence - 2 '...beginnend vanaf de meest recente entry If TekstWoordNummer - .worksheets(3).Cells(nPropNamSequence - i, 27) < 750 Then ' 750 = gekozen constante voor "Propra-Nomo Text-Coherence", ivm geadjectiveerde Propraj Nomoj If BeginHoofdletterWeg(.worksheets(3).Cells(nPropNamSequence - i, 28)) = StamAdjectief Then GoTo 27738 Else GoTo 27739 'in naburige Text (750 tekstwoorden) GEEN match van Adjectief-Stam met Propra Nomo gevonden End If Next i GoTo 27739 'in hele tekst GEEN match van Adjectief-Stam met Propra Nomo gevonden 27738: 'Propra Nomo gevonden gelijk aan de Adjectief-Stam: struct(1) = .worksheets(3).Cells(nPropNamSequence - i, 28) & ChrW(MorDis) & UitgangAdjectief 'struct(1) wordt samengesteld .worksheets(Wsh).Cells(InsertPos, 8 + 1) = struct(1) '...ook in de TaalwoordLijst If UitgangAdjectief = "a" Then VortSpecMarko = "A" 'woordsoort wordt ipv "fout" nu Adjectief ElseIf UitgangAdjectief = "an" Then: VortSpecMarko = "A4" ElseIf UitgangAdjectief = "aj" Then: VortSpecMarko = "Aj" ElseIf UitgangAdjectief = "ajn" Then: VortSpecMarko = "A4j" End If .worksheets(Wsh).Cells(InsertPos, 4) = VortSpecMarko ' "f" (fout-teken) wordt overschreven door adjectief-teken .worksheets(Wsh).Cells(InsertPos, 7) = 0 'GenVoc = 0 .worksheets(Wsh).Cells(InsertPos, 8) = "E-A" 'speciaal teken voor ne-envortara Eigennaam-Adjectivering (Propra-Nomo adjectivering) GoTo 279 27739: End If '[einde 29-3-08] If nstruct = 0 Then 'meestal is een fout woord is gestrand IN Kunmetanaliz (ongeveer de "bezemwagen" van woordcontrole) of al door een voorafgaand filter (CerteFremdLingva); ... '...in dat geval zijn er dus GEEN morfeemstructuren doorgegeven en dus is nstruct=0: .worksheets(Wsh).Cells(InsertPos, 6) = "'f" 'deze "dubbele" registratie van "f" vergemakkelijkt het snel uitsorteren van foute woorden in de Excel- TaalwoordLijst '[29-2-08] 'TekstWoord = TekstWoord '.Worksheets(Wsh).Cells(InsertPos, 6) is verder gereserveerd voor plaatsing van Ambigumark bij een zgn. Nul-Entry [zie hierboven, rond label 277] Else 'If nstruct > 0 Then 'maar ook kan de afkeuring van een woord gebeurd zijn NA het doorlopen van KunmetAnaliz, in TekstVortKontrol: ... 'Ook bij fout woord kan er sprake zijn van een morfeemstructuur en zelfs meerdere splitsingsvarianten, namelijk in OpcioIV... '[22-10-08] '... dit gebeurt namelijk in OpcioIV (BROonly) bij gevallen als "rekt-or-o", "ar-o-gant-ec-o", etc., waar klaarblijkelijk "rektor-o" resp. "arogant-ec-o" bedoeld was; '... hoewel hier sprake is van een fout woord is er toch een morfeemstructuur en soms zelfs meerdere varianten, die ... '... in deze gevallen toch in de kolommen H t/m L van de TaalWoordLijst worden uitgeschreven (mede voor TEST-doeleinden): .worksheets(Wsh).Cells(InsertPos, 6) = "'f*" 'deze gevallen worden in kolom 6 aangeduid door f met sterretje '[22-10-08] .worksheets(Wsh).Cells(InsertPos, 8) = SamenstellingOrHyphenatedIndicator '.worksheets(Wsh).Cells(InsertPos, 8).Font.ColorIndex = 3 'ROOD maken '[22-10-08] (format change geeft echter problemen bij continue alfabetische omsortering van TaalWoordLijst) For i = 1 To nstruct '(nstruct is max. 4, wat betekent dat bij Samenstellingen max. 4 varianten kunnen worden doorgegeven) '[22-10-08] .worksheets(Wsh).Cells(InsertPos, 8 + i) = struct(i) 'Splitsings-varianten komen in de Kolommen 9 - 12 (Voorkeurs-Splitsing in kolom 9) '.worksheets(Wsh).Cells(InsertPos, 8 + i).Font.ColorIndex = 3 'ROOD maken '[22-10-08] (format change geeft echter problemen bij continue alfabetische omsorteringvan TaalWoordLijst) Next i End If GoTo 279 '[22-10-08] End If '(Einde behandeling Foute woorden) 27740: .worksheets(Wsh).Cells(InsertPos, 8) = SamenstellingOrHyphenatedIndicator 'bij hyphenated woord bovendien een speciale code in een aparte kolom '[30-10-06] 'Altijd (ook voor Niet-Samengestelde woorden) wordt de morfeeem-structuur in de TaalWoordLijst opgeslagen: For i = 1 To nstruct '(nstruct is max. 4, wat betekent dat bij Samenstellingen max. 4 varianten kunnen worden doorgegeven) .worksheets(Wsh).Cells(InsertPos, 8 + i) = struct(i) 'Splitsings-varianten komen in de Kolommen 9 - 12 (Voorkeurs-Splitsing in kolom 9) Next i If InStr(1, SamenstellingOrHyphenatedIndicator, "s") Then 'WoordSamenstelling (in unhyphenated Woord of in WoordDeel van hyphenated woord): WoordIsSamenstelling = True 'als beide WoordDelen van een hyphenated woord elk zijn Samengesteld, dan worden bij een H2-woord de volgcellen 9 en 10 gebruikt voor het ene WoordDeel (links van het Hyphen), ... ' ...en de volgcellen 11 en 12 gebruikt voor het andere WoordDeel (rechts van het Hyphen); voor elk van beiden kunnen dan max. 2 Splitsings-varianten worden getoond; bij een ... ' ...H3- of H4-woord kan zal van elke evt. Samenstelling alleen de Voorkeurs-variant worden getoond; ... ' ...'nstruct' (max. 4) geeft bij hyphenated woorden geeft altijd het totaal van ALLE Samenstellings-varianten gezamenlijk aan '[30-10-06; het gebruik van "|" vervalt hiermee] 'Voor Samenstellingen (ook in WoordDeel van hyphenated woord): '[22-2-2008] nNeEnvortaraKunmeto = nNeEnvortaraKunmeto + 1 'Speciale check bij een adjectief, of dit ipv ne-envortara kunmeto een geadjectiveerde Propra Nomo betreft [29-3-08]: 'If Right(TekstWoord, 1) = "a" Or Right(TekstWoord, 2) = "an" Or Right(TekstWoord, 2) = "aj" Or Right(TekstWoord, 3) = "ajn" Then If Left(VortSpecMarko, 1) = "A" Then 'bij adjectief-uitgang: i = InStr(1, StrReverse(TekstWoord), "a") UitgangAdjectief = Right(TekstWoord, i) StamAdjectief = Left(TekstWoord, Lengte - i) 'Doorzoek Text-Coherence stack van Propraj Nomoj, ... For i = 0 To nPropNamSequence - 2 '...beginnend vanaf de meest recente entry If TekstWoordNummer - .worksheets(3).Cells(nPropNamSequence - i, 27) < 750 Then ' 750 = gekozen constante voor "Propra-Nomo Text-Coherence", ivm geadjectiveerde Propraj Nomoj If BeginHoofdletterWeg(.worksheets(3).Cells(nPropNamSequence - i, 28)) = StamAdjectief Then GoTo 27748 Else GoTo 27749 'in naburige Text (750 tekstwoorden) GEEN match van Adjectief-Stam met Propra Nomo gevonden End If Next i GoTo 27749 '[22-5-08] 27748: 'Propra Nomo gevonden gelijk aan de Adjectief-Stam: struct(1) = .worksheets(3).Cells(nPropNamSequence - i, 28) & ChrW(MorDis) & UitgangAdjectief 'struct(1) wordt overschreven,... .worksheets(Wsh).Cells(InsertPos, 8 + 1) = struct(1) '...ook in de TaalwoordLijst .worksheets(Wsh).Cells(InsertPos, 8) = "E-A" 'speciaal teken voor ne-envortara Eigennaam-Adjectivering (Propra-Nomo adjectivering) WoordIsSamenstelling = False: nNeEnvortaraKunmeto = nNeEnvortaraKunmeto - 1 For i = 2 To nstruct: .worksheets(Wsh).Cells(InsertPos, 8 + i) = "": Next i 'weghalen van evt. verdere samenstellingsvarianten 27749: End If '[einde 29-3-08] End If GoTo 279 278: If .worksheets(Wsh).Cells(MatchPos, 3) = 0 Then 'uitzondering: "Verfijning EBO-gevallen" [3-2-2008]: 'TekstWoord matcht met een reeds in de TaalWoordLijst aanwezige Nul-Entry van het woord: [4-3-08] If UnmarkedCap Then 'telt alsof er GEEN match met Taalwoordlijst is, want een tweede Unmarked Cap verandert niets aan de onzekerheid (AmbiguMark) veroorzaakt door een eerste Unmarked Cap '[4-3-08] GoTo 700 '[4-3-08] End If 'Ontdekking van Nul-Entry kan hier in toekomstige versies EVT. ACTIE triggeren: na mogelijke interactie per user-interface, ... ' ...de voorafgegane Unmarked Cap(s) van EigennaamLijst omboeken naar TaalwoordLijst. 'In deze voorlopige versie alleen de Nul-Entry in de TaalwoordLijst overschrijven met een gewone Entry: 'aangezien de Nul-Entry geen gegevens (zoals VortspecMarko, ...., struct) bevat, moeten alsnog de Dictionaries geraadpleegd worden: OverschrijvingNulEntry = True '[4-3-08] InsertPos = MatchPos '[4-3-08] .worksheets(Wsh).Cells(InsertPos, 6) = "" 'EBO...-AmbiguMark kan nu weggehaald worden [4-3-08] GoTo 720 '[4-3-08] Else 'TekstWoord matcht met een reeds in de TaalWoordLijst GEWOON aanwezig woord: struct(1) = .worksheets(Wsh).Cells(MatchPos, 9) 'de in de TaalWoordLijst opgeslagen morfeem-struktuur dient weer voor VISUALISERING in de MS WORD source-tekst nstruct = 1 '[20-1-09 (reparatie, n.a.v. fout "ndfederacio" volgend op "por Mondfederacio")] .worksheets(Wsh).Cells(MatchPos, 3) = .worksheets(Wsh).Cells(MatchPos, 3) + 1 'AbsFreq ophogen 'Voor Samenstellingen (ook in WoordDeel van hyphenated woord): '[22-2-2008] If InStr(1, .worksheets(Wsh).Cells(MatchPos, 8), "s") Then nNeEnvortaraKunmeto = nNeEnvortaraKunmeto + 1 '[22-2-2008] End If 279: 'Einde behandeling Gewoon Taalwoord WstatnTaalWoord = WstatnTaalWoord + 1 'N.B.: Samengestelde woorden met 1 of meer hyphen's erin, 'worden hier als 1 Tekstwoord en Taalwoord behandeld! End If GoTo 160 280: 'Cijfers of cijferwoorden (=woorden die BEGINNEN met cijfer): '[*nieuwe behandeling vanaf 26-4-2005] '-----Toegevoegde behandeling [26-11-05] ivm VortSpecEnFrazo-registratie----: If Right(TekstWoord, 1) = "a" Then 'elk tekstwoord beginnend met cijfer en eindigend op -a : VortSpecMarko = "A" 'bijv. 2a, 133a, 27-a, 3D-figura ElseIf (Lengte >= 3 And Right(TekstWoord, 2) = "an") Then 'eindigend op -an : VortSpecMarko = "A4" 'bijv. 2an, 133an, 27-an, 3D-figuran ElseIf (Lengte >= 3 And Right(TekstWoord, 2) = "aj") Then 'eindigend op -aj : VortSpecMarko = "Aj" 'bijv. 3D-figuraj ElseIf (Lengte >= 4 And Right(TekstWoord, 3) = "ajn") Then 'eindigend op -ajn : VortSpecMarko = "A4j" 'bijv. 3D-figurajn ElseIf Right(TekstWoord, 1) = "o" Then 'eindigend op -o : VortSpecMarko = "N" 'bijv. 3D-figuro ElseIf (Lengte >= 3 And Right(TekstWoord, 2) = "on") Then 'eindigend op -on : VortSpecMarko = "N4" 'bijv. 3D-figuron ElseIf (Lengte >= 3 And Right(TekstWoord, 2) = "oj") Then 'eindigend op -oj : VortSpecMarko = "Nj" 'bijv. 3D-figuroj ElseIf (Lengte >= 4 And Right(TekstWoord, 3) = "ojn") Then 'eindigend op -ojn : VortSpecMarko = "N4j" 'bijv. 3D-figurojn Else VortSpecMarko = "#" 'alle overige cijferwoorden worden met VortSpeco 'numeralo' geclassificeerd End If '----- WstatnCijferWoord = WstatnCijferWoord + 1 'Elk TekstWoord dat begint met cijfer(s) maar evt. ook letter(s) bevat wordt opgeslagen... '...om evt. latere controle (opsporing van fouten in brontekst) mogelijk te maken: If WstatnCijferWoord <= 750 Then CijferWoordOpslag(WstatnCijferWoord) = TekstWoord '[lengte Opslag-Array =750] GoTo 160 285: 'Woord is een r e t a d r e s o (website-naam of email-adres): '[25-2-2008] VortSpecMarko = "@" '----- nRetadreso = nRetadreso + 1 'Elk Retadreso wordt opgeslagen... '...om evt. latere controle (opsporing van fouten in brontekst) mogelijk te maken: If nRetadreso <= 250 Then RetadresoOpslag(nRetadreso) = TekstWoord '[lengte Opslag-Array =250] GoTo 160 290: 'Woord bestaat alleen maar uit Leestekens: 'cursieve leestekenwoorden evt. overspringen: If Selection.Font.Italic And SkipKursiv Then GoTo 163 'If MsgBox("leestekenwoord = |" & TekstWoord & "| Doorgaan?", vbYesNo) = vbNo Then GoTo 999 '-----Toegevoegde behandeling [26-11-05] ivm VortSpecEnFrazo-registratie [vanwege Excel beperkt tot Ascii-tekens!]----: If TekstWoordVoorAfstrippen = "," Or TekstWoordVoorAfstrippen = ";" Or TekstWoordVoorAfstrippen = ":" _ Or TekstWoordVoorAfstrippen = "." Or TekstWoordVoorAfstrippen = "?" Or TekstWoordVoorAfstrippen = "!" Then VortSpecMarko = TekstWoordVoorAfstrippen '(de gewone leestekens die los staan van het voorafgaande woord blijven behouden) ElseIf TekstWoordVoorAfstrippen = "(" Or TekstWoordVoorAfstrippen = "[" Then VortSpecMarko = "(" 'een losstaande openingshaak wordt op "(" afgebeeld; ElseIf TekstWoordVoorAfstrippen = ")" Or TekstWoordVoorAfstrippen = "]" Then VortSpecMarko = ")" 'een losstaande sluithaak wordt op ")" afgebeeld; ElseIf TekstWoordVoorAfstrippen = "..." Or TekstWoordVoorAfstrippen = ChrW(8230) Or TekstWoordVoorAfstrippen = "...." Then 'VortSpecMarko = ";" 'een losstaande 'tripunkto' wordt op puntkomma afgebeeld; '[*oude situatie; leidde tot verwerkingsfouten bij SVO-analyse] 'VortSpecMarko = ChrW(247) 'een losstaande 'tripunkto' wordt op Unicode 247 (streepje met puntje erboven en puntje eronder) afgebeeld; [8-7-07] VortSpecoHaltoStreko = True 'een losstaande 'tripunkto' wordt (net als de gedachtenstreep) op het gewone streepje (Ascii 45) afgebeeld; [30-7-2007] jTekstWoord = jTekstWoord - 1 'correctie voor pseudo-woord dat door eerdere AZM macro niet is meegeteld in nZinsLengte 'pseudo-woord oversprongen ElseIf TekstWoordVoorAfstrippen = ChrW(45) Or TekstWoordVoorAfstrippen = ChrW(150) Or TekstWoordVoorAfstrippen = ChrW(151) _ Or TekstWoordVoorAfstrippen = ChrW(8211) Or TekstWoordVoorAfstrippen = ChrW(8212) Then VortSpecMarko = "-" 'een gedachtenstreep wordt op het gewone streepje (Ascii 45) afgebeeld; Else VortSpecMarko = ChrW(126) 'alle overige tekens of tekengroepen op spekhaak (Ascii 126) afbeelden. End If 'N.B. In het bovenstaande is NIET rekening gehouden met losstaande citiloj (WEL met losstaande haken en losstaande gewone leestekens). '----- nLeestekenWoord = nLeestekenWoord + 1 'Elk LeestekenWoord wordt opgeslagen... '[*nieuwe behandeling vanaf 26-4-2005] '...om evt. latere controle (opsporing van fouten in brontekst) mogelijk te maken: If nLeestekenWoord <= 250 Then LeestekenWoordOpslag(nLeestekenWoord) = TekstWoordVoorAfstrippen '[lengte Opslag-Array =250] GoTo 160 160: 'Monitoring en Overloop-Beveiliging van ingevulde Woordlijst: 'tussenstanden: 'If WstatnLijstWoord = 5000 Or WstatnLijstWoord = 10000 Or WstatnLijstWoord = 12500 Or WstatnLijstWoord = 14250 Then ' If MsgBox("Er staan nu " & WstatnLijstWoord & " entries in de TaalwoordLijst, nog verder gaan?", _ ' vbYesNo) = vbNo Then GoTo 666 'voortijdig stoppen 'End If 'max. stand (ivm max. lengte van Excel-kolom): If WstatnLijstWoord = 62000 Then MsgBox "Er staat nu bijna het MAX. AANTAL (62000) entries in de TaalwoordLijst" 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) 'ONDERSTAANDE BLOKKEN betreffen SYNTACTISCHE.behandeling: If Not SyntacticAnalysis Then GoTo 166 'Syntactische Behandeling afhankelijk van ingestelde schakelaar {zie begin macro] 'Op grond van de woordstructuur registreren van Transitief-Participiaal adjectieven of adverbia (bijv. "plenumigante"): [31-7-2007] If WoordIsSamenstelling Then If Len(struct(1)) > 9 And InStr(5, struct(1), "nt" & ChrW(MorDis)) Then '[snelle voorselectie] If InStr(Len(struct(1)) - 9, struct(1), ChrW(MorDis) & "ig" & ChrW(MorDis) & "ant" & ChrW(MorDis) & "a") _ And (Right(struct(1), 1) = "e") Then '[1-8-07: adjectieven nog even uitstellen] 'And (Right(struct(1), 1) = "e" Or Right(struct(1), 1) = "a" Or Right(struct(1), 2) = "aj") Then VortSpecMarko = "T" ' = Transitief-Participiaal adjectief of adverb ElseIf InStr(Len(struct(1)) - 9, struct(1), ChrW(MorDis) & "ig" & ChrW(MorDis) & "int" & ChrW(MorDis) & "a") _ And (Right(struct(1), 1) = "e") Then '[1-8-07: adjectieven nog even uitstellen] 'And (Right(struct(1), 1) = "e" Or Right(struct(1), 1) = "a" Or Right(struct(1), 2) = "aj") Then VortSpecMarko = "T" ' = Transitief-Participiaal adjectief of adverb ElseIf InStr(Len(struct(1)) - 9, struct(1), ChrW(MorDis) & "ig" & ChrW(MorDis) & "ont" & ChrW(MorDis) & "a") _ And (Right(struct(1), 1) = "e") Then '[1-8-07: adjectieven nog even uitstellen] 'And (Right(struct(1), 1) = "e" Or Right(struct(1), 1) = "a" Or Right(struct(1), 2) = "aj") Then VortSpecMarko = "T" ' = Transitief-Participiaal adjectief of adverb End If End If 'Deze T-markering wordt hier alleen toegepast op Transitieve Participia waarin het morfeem "ig" aan "-ant", "-int", etc. voorafgaat. '[Voor alle overige participia van Transitieve Verba (bijv. "aĉeti", "preni", "voki") is voorlopig nog geen registratie van kracht, ... ' ...omdat daarvoor info (synmark) vanuit macro KunmetAnaliz via macro TekstVortKontrol doorgegeven moet worden]. [31-7-2007] 'Transitieve Participia in adjectief-vorm op -an of -ajn worden NIET geregistreerd om de volgende reden: 'Het doel van de VortSpec "T" is het opsporen van Verb-Object relaties wanneer het Transitive Verb in adverbiale of adjectivische vorm... '...staat, dus bijv. "plenumigante la taskon", "mortiganta la hundon", etc. Indien echter het Participium-adjectief zelf in accusatief staat en... '... bovendien een Object heeft, kunnen de 2 accusatieven verwarring opleveren (bijv. bij "oni punis la infanojn mortigantajn hundojn") over... '... wat Object en wat Subject is van het onderliggend Transitief Verb. End If '[**bovenstaande 31-7-2007 -blok werkt alleen indien het voorafgaat aan de SYNTACTISCHE ZINS-REGISTRATIE] 'Bijhouden SYNTACTISCHE ZINS-REGISTRATIE in WorkSheet 5: '[30-10-06] '[28-2-08: Worksheetnummer veranderd van 4 in 5 ] 'VortSpecMarko (1-3 tekens) van het behandelde woord REGISTREREN... '[24-11-2005] ' ... in de VortSpecEnFrazo-STRING van de AZM-zin, met daaraan toegevoegd... ' ... ook de evt. leestekens (genormeerd) voor of achter dat woord: If VortSpecoHaltoStreko Then ZinSTR = "-" 'representeert Gedachtenstreep en (al dan niet gespatieerde) Ellipsis GoTo 165 End If ZinSTR = "" 'reset If VortSpecoBeginHaak Then ZinSTR = "(" If VortSpecoBeginQuote Then ZinSTR = ZinSTR & "<" 'alle beginquotes gemapt op < If Left(VortSpecMarko, 2) = "EO" Then '[16-5-08]: bij EON, EON4, EOA, EOW, EOp, EOf, etc: ZinSTR = ZinSTR & "E" '(alleen de letter E als code ) ElseIf Left(VortSpecMarko, 2) = "EB" Then If Left(VortSpecMarko, 3) = "EBO" Then '[16-5-08]: bij EBON, EBON4, EBOA, EBOW, EBOp, EBOf, etc: ZinSTR = ZinSTR & "E" '(alleen de letter E als code ) ElseIf Left(VortSpecMarko, 3) <> "EB&" Then '[16-5-08]: bij EB : (let op: bij EB zonder toevoeging &N, &N4, &A, etc) ZinSTR = ZinSTR & "E" '(alleen de letter E als code ) Else '[16-5-08]: bij EB&N, EB&N4, EB&A, EB&A4, etc: ZinSTR = ZinSTR & VortSpecMarko '(hier de volledige code, bijv. EB&N, EB&N4, etc) End If Else 'If VortSpecMarko = ChrW(285) Then 'ChrW(285) = "ĝ" ' ZinSTR = ZinSTR & "p" '[26-5-08: indien men 'dum' en 'ĝis' in de VortSpecEnFrazo-STRING zou willen registreren als Prepozicioj ] 'Else ZinSTR = ZinSTR & VortSpecMarko 'de via CheckEspWord (of via blok 280 of 290) verkregen WoordSoort-kode 'End If End If If VortSpecoEindQuote Then ZinSTR = ZinSTR & ">" 'alle eindquotes gemapt op > If VortSpecoSluitHaak Then ZinSTR = ZinSTR & ")" If VortSpecoKommaEtc Then ZinSTR = ZinSTR & KommaEtc 'evt. komma, puntkomma, dubbele punt, punt, streepje (Ascii 45) '[31-7-07] 'TYDELIJKE OPSLAG van tekstwoord ten behoeve van SYNTAX-SUBj-OBJ-VERB-PAIRS: [11 juni 2007] WoordOpWoordPositie(jTekstWoord) = TekstWoord 165: If VortSpecoHaltoStreko Then '[30-07-2007] 'ketens van losstaande tekens (gespatieerde ellipsis) door 1 teken representeren: If jTekstWoord = 0 Then '[24-5-08] ZinBegintMetHaltoStreko = True '[24-5-08] VortSpecEnFrazo2 = ZinSTR '[24-5-08] ElseIf Right(VortSpecEnFrazo2, 1) = "." Then VortSpecEnFrazo2 = Left(VortSpecEnFrazo2, Len(VortSpecEnFrazo2) - 1) & ZinSTR ElseIf Not (Right(VortSpecEnFrazo2, 1) = "-") Then VortSpecEnFrazo2 = VortSpecEnFrazo2 & ZinSTR End If Else 'in alle overige gevallen: VortSpecEnFrazo2 = VortSpecEnFrazo2 & ZinSTR End If 166: 'FOUT-ATTENDERING en MORFEEM-STRUKTUUR-VISUALISERING in de MS WORD source-tekst: 'In Source-Tekstfile ROOD markeren van Foute Esp.woorden en (ne-majuskligitaj) FremdVortoj [23-12-2005]: If VortSpecMarko = "f" Then 'Foute woorden of Niet-Esp. woorden (zonder hoofdletter, dus GEEN Eigennamen): Selection.Font.Underline = wdUnderlineWavy 'fout woord wordt geribbeld onderstreept ... Selection.Font.Color = wdColorRed '... en rood gemaakt Selection.Collapse direction:=wdCollapseEnd '[21-11-06] nFoutOfFremdWoord = nFoutOfFremdWoord + 1 'Telling van Foute woorden 'Telling welke van de Foute woorden Foute Samenstellingen (Foute Ne-Envortaraj Kunmetoj) zijn: If WoordIsSamenstelling Then nFouteSamenstelling = nFouteSamenstelling + 1 GoTo 167 'behalve roodkleuring en geribbelde onderstreping wordt aan het foute woord in de source-tekst NIETS veranderd End If If VortSpecMarko = "EOf" Then 'Foute woorden of Niet-Esp. woorden (met hoofdletter, dus mogelijke Eigennamen) ... Selection.Font.Color = wdColorPink '... worden rozerood gemaakt (en NIET geribbeld onderstreept) Selection.Collapse direction:=wdCollapseEnd '[20-1-08] nHalfFoutOfFremdWoord = nHalfFoutOfFremdWoord + 1 'Telling van deze 'Halffoute' woorden (necertaj eraroj) GoTo 167 'behalve roodkleuring wordt aan het foute woord in de source-tekst NIETS veranderd End If 'In gevallen waarbij struct(1) ontbreekt, zoals bij NE-Asimilitaj Eigennamen, bij cijfer- en leestekenwoorden: If struct(1) = "" Then Selection.Collapse direction:=wdCollapseEnd GoTo 168 'onderstaand blok overspringen End If 'BLUIGU NE-ENVORTARA KUNMETAJHO [12-5-08]: If BluiguNeEnvort And WoordIsSamenstelling Then If Lengte > MaxLenSenBluig Then 'een SAMENSTELLING wordt BLAUW gemaakt indien gebruiker deze optie koos Selection.Font.Color = wdColorBlue End If End If 'BIJHOUDEN VAN WOORDLENGTE-STATISTIEK (VAN TAALWOORDEN) [23-12-08] 'geldt alleen voor LINGVAJ VORTOJ '(NIET voor propraj nomoj, adresvortoj, 'cifervortoj' en 'signovortoj', en ook NIET voor foute of vreemde [rood- en roze-gekleurde] taalwoorden): 'LenW = Len(TekstWoord) 'LenW = aantal tekens (letters) in het woord '[18-1-09: variabele '"LenW" bij nader inzien overbodig; "Lengte" voldoet] 'If LenW <> Lengte And Right(TekstWoord, 1) <> "." Then MsgBox "LenW <> Lengte" 'wschl was "LenW" niet nodig; "Lengte" voldoet [inschatting op 23-12-08] 'If LenW > 50 Then 'bovenstaand stmt voorziet in het optreden van afkortingswoorden-eindigend-op-punt', bijv. " ekz. " [9-1-09] ' MsgBox "tekstwoord overschrijdt max. lengte" 'Else If Lengte > 0 Then 'als bijdrage voor berekening gemiddelde: nTotaalAantalTaalWoorden = nTotaalAantalTaalWoorden + 1 WstatnTotaalTaalWoordlengten = WstatnTotaalTaalWoordlengten + Lengte 'voor in kaart brenging verdeling en berekening standaard deviatie e.d.: WoordLengte(Lengte) = WoordLengte(Lengte) + 1 WstatnTotaalKwadrWoordlengten = WstatnTotaalKwadrWoordlengten + Lengte * Lengte '(bij de array-dimensionering is uitgegaan van een max. woordlengte van 50) End If 'PLAATSING VAN EEN OPTIONAL HYPHEN IN LANGERE WOORDSAMENSTELLINGEN: '[12-12-08] 'doel hiervan is: in de MS WORD brontekst een Optional Hyphen (unicode 31) te plaatsen, op een voor afbreking-aan-het-eind-van-een-regel gunstige positie in het woord If PlaatsingOptHyphens Then 'al dan niet plaatsing van Optional Hyphens is een gebruikersoptie If iPosOptionalHyphen > 3 Then 'alleen voor Ne-envortaraj Kunmetoj wordt er (door macro KunmetAnaliz) een Positie voor de Optional Hyphen doorgegeven, ... '...maar bovendien stellen we in als regel dat er MINSTENS 3 LETTERS aan de Optional Hyphen moeten voorafgaan: If Lengte >= 12 Then 'alleen bij een woord langer dan 12 letters (MORDIS-tekens NIET meetellend) wordt een Optional Hyphen geplaatst struct(1) = Left(struct(1), iPosOptionalHyphen - 1) & ChrW(31) & Right(struct(1), Len(struct(1)) - (iPosOptionalHyphen - 1)) '.worksheets(Wsh).Cells(InsertPos, 9) = struct(1) '** <== dit stmt ALLEEN voor AANMAAK VAN WOORDENBOEK-ENTRIES met OptionalHyphen erin Else GoTo 164 'skip OptionalHyphen '22-12-08 End If ElseIf iPosOptionalHyphen > 0 Then 'If iPosOptionalHyphen = 3 (or 2): iPosOptionalHyphen = 0 '2-letterige woorddelen aan het eind van een regel (ne-, re-, de-, el-, ek-, al-, ge-, po-, di-, te-, le-, ....) moeten geweerd worden [22-12-08] GoTo 164 'skip OptionalHyphen '22-12-08 Else 'If iPosOptionalHyphen = 0: 'voor Envortaraj Kunmetoj wordt een iPosOptionalHyphen eventueel gevonden in de struct(1) van het woord: '[in Envortaraj Kunmetoj korter dan 12 letters (MORDIS-tekens NIET meetellend) kunnen GEEN Optional Hyphens voorkomen]: iPosOptionalHyphen = InStr(5, struct(1), ChrW(31)) 'er wordt pas vanaf het 5e teken naar een OptionalHyphen gekeken (eraan vooraf gaat minstens 1 MORDIS, dus MINSTENS 3 LETTERS) If iPosOptionalHyphen = 0 Then GoTo 164 'skip OptionalHyphen '22-12-08 End If If Not MorphemizerSwitchedOn Then '22-12-08 struct(1) = HaalMORDISWeg(struct(1)) 'verwijder eerst alle MORDIStekens uit struct(1) Selection.TypeText struct(1) 'brontekstwoord in MS WORD wordt nu vervangen door hetzelfde woord met (onzichtbaar) OptionalHyphen; '[indien MorphemizerSwitchedOn dan gebeurt dit hieronder bij de Vervanging van een woord door zijn Morfeemstructuur] Else 'If MorphemizerSwitchedOn: If DisigNurPlilong And (Lengte <= MaxLenSenDisig) Then struct(1) = HaalMORDISWeg(struct(1)) 'verwijder eerst alle MORDIStekens uit struct(1) Selection.TypeText struct(1) 'brontekstwoord in MS WORD wordt nu vervangen door hetzelfde woord met (onzichtbaar) OptionalHyphen; End If '[indien (Not DisigNurPlilong) Or Lengte > MaxLenSenDisig dan gebeurt dit hieronder bij de Vervanging van een woord door zijn Morfeemstructuur] End If End If 164: 'VERVANGEN VAN EEN WOORD IN DE SOURCE-TEKST door zijn MORFEEM-STRUCT: '[30-10-06] If MorphemizerSwitchedOn Then If (Not DisigNurPlilong) Or Lengte > MaxLenSenDisig Then If UnmarkedCap Then 'Voorkom dat door overschrijving met 'Struct' een BeginHoofdletter verdwijnt: '[15-11-06] struct(1) = BeginHoofdletterTerug(struct(1)) End If 'Bij woorden die een (niet in het Dict staande) SAMENSTELLING zijn, waarbij morfeem-structuur dient als Splitsingstekens: [23-12-2005]: If WoordIsSamenstelling Then '[30-10-06] If nstruct > 1 Then Selection.Font.Underline = wdUnderlineDotted 'een woord waarvoor MEERDERE Structs gevonden zijn... Selection.Font.UnderlineColor = wdColorAutomatic '...wordt ONDERSTIPPELD End If Selection.TypeText struct(1) 'If Right(VortSpecMarko, 1) = "W" Then Selection.MoveEnd Unit:=wdCharacter, Count:=2 'Indikativo of Kondicionalo (vervoegd Werkwoord op -as, -is, -os, -us) 'If Right(VortSpecMarko, 1) = "i" Then Selection.MoveEnd Unit:=wdCharacter, Count:=2 'Infinitivo (Werkwoord op -i) 'If Right(VortSpecMarko, 2) = "Wu" Then Selection.MoveEnd Unit:=wdCharacter, Count:=1 'Volitivo (vervoegd Werkwoord op -u) If DisigNurNeEnvort Then GoTo 167 'Bij gewone woorden (GEEN Samenstellingen, GEEN EIgennamen, GEEN Functiewoorden): '[30-10-06] '####misschien nog correctie voor "-en" aanbrengen? '[30-10-06] ElseIf (Left(VortSpecMarko, 1) = "N" Or Left(VortSpecMarko, 1) = "A" Or Left(VortSpecMarko, 1) = "W" Or Left(VortSpecMarko, 1) = "i" Or (Left(VortSpecMarko, 1) = "b" And Right(TekstWoord, 1) = "e")) Then '[30-10-06] If DisigChiujnVort Then Selection.TypeText struct(1) Else Selection.Collapse direction:=wdCollapseEnd 'If Right(VortSpecMarko, 1) = "W" Then Selection.MoveEnd Unit:=wdCharacter, Count:=2 'Indikativo of Kondicionalo (vervoegd Werkwoord op -as, -is, -os, -us) 'If Right(VortSpecMarko, 1) = "i" Then Selection.MoveEnd Unit:=wdCharacter, Count:=2 'Infinitivo (Werkwoord op -i) 'If Right(VortSpecMarko, 2) = "Wu" Then Selection.MoveEnd Unit:=wdCharacter, Count:=1 'Volitivo (vervoegd Werkwoord op -u) 'Bij Functiewoorden (incl. Verbuigbare Functiewoorden): '[30-10-06] 'ElseIf VortSpecMarko <> "E" Then '[dit stmt 5-2-2008 vervangen door onderstaand stmt] ElseIf Left(VortSpecMarko, 1) <> "E" Then If Left(VortSpecMarko, 1) = "p" Then If Left(struct(1), 4) = "dank" Then If struct(1) = "dank' al" Or struct(1) = "dank" & ChrW(8217) & " al" Then Selection.MoveStart unit:=wdCharacter, Count:=-6 '(uitzondering vanwege interne spatie) [6-10-08] End If End If 'Selection (geselecteerde Tekstwoord) vervangen of wijzigen: If DisigChiujnVort Then Selection.TypeText struct(1) Else Selection.Collapse direction:=wdCollapseEnd 'Bij Eigennamen: 'ElseIf VortSpecMarko = "E" Then 'Hoofdletter(s) herstellen '###### '[30-10-06] 'maar verder NIET vervangen of wijzigen '[30-10-06] 'End If 'Eigennamen moeten ALLEEN als ze in het 'EigennamenBoek' staan en 'Asimilitaj' zijn door een morfeemstructuur vervangen worden: ElseIf Left(VortSpecMarko, 3) = "EB&" Then '[5-2-2008] 'Selection (geselecteerde Tekstwoord) vervangen of wijzigen: If DisigChiujnVort Then Selection.TypeText struct(1) Else Selection.Collapse direction:=wdCollapseEnd End If Else 'If DisigNurPlilong And (Lengte <= MaxLenSenDisig) Then: Selection.Collapse direction:=wdCollapseEnd '[in het tegengestelde geval werd dit impliciet door "Selection.TypeText struct(1)" gedaan] End If Else 'If NOT MorphemizerSwitchedOn Then: Selection.Collapse direction:=wdCollapseEnd '[bij MorphemizerSwitchedOn werd dit impliciet door "Selection.TypeText struct(1)" gedaan] End If 167: 'EINDE van WOORD-behandeling: 'Selection.Collapse direction:=wdCollapseEnd '[30-10-06]: niet meer nodig 'Afsluiting van deze doorgang door jTekstWoord-LOOP en voorbereiding voor evt. volgende woord: For i = 1 To nstruct struct(i) = "" 'reset voor volgend woord '[30-10-06] Next i GoTo 168 163: 'Afhandeling van Oversprongen woord: Selection.Font.Color = wdColorGray35 'lichtere grijstint voor elk oversprongen woord 'Selection.Range.HighlightColorIndex = wdYellow '*tijdens TESTS: highlighting van elk oversprongen woord '[14-4-2008] 'MsgBox "---- ----" '*tijdens TESTS: aanduiding na oversprongen woord '[14-4-2008] Selection.Collapse direction:=wdCollapseEnd If SyntacticAnalysis Then VortSpecEnFrazo2 = VortSpecEnFrazo2 + "e" ''e" ( 'empty') komt in Syntactische Zins-Registratie PreviousTekstWoord = "" If jTekstWoord = nZinsLengte Then GoTo 169 'woord was laatste woord van zin Else 'If jTekstWoord =< nZinsLengte -1 Then: Selection.MoveStart unit:=wdCharacter, Count:=1 + nAfstrippingenAchterkant nAfstrippingenAchterkant = 0 'reset voor evt. volgend woord End If GoTo 161 168: 'MsgBox "------------" '*tijdens TESTS: aanduiding einde woord-behandeling EBOinTaalwoordLijst = False 'reset '[3-2-2008] OverschrijvingNulEntry = False 'reset '[4-3-2008] iPosOptionalHyphen = 0 'reset [12-12-08] If jTekstWoord = nZinsLengte Then PreviousTekstWoord = "" '[12-4-2008] PreviousMajusklaVort = False GoTo 169 'woord was laatste woord van zin Else 'If jTekstWoord =< nZinsLengte -1 Then: Selection.MoveStart unit:=wdCharacter, Count:=1 + nAfstrippingenAchterkant nAfstrippingenAchterkant = 0 'reset voor evt. volgend woord PreviousTekstWoord = TekstWoord '[12-4-2008] PreviousMajusklaVort = MajusklaVort '[24-4-08] End If 161: Next jTekstWoord 'ONDER-EIND VAN BINNENLUS 'FINO DE INGITA ITERACIO TRA ĈIUJ VORTOJ DE FRAZO 169: 'EINDE van ZIN: WstatnAantalZinnen = WstatnAantalZinnen + 1 WstatnTotaalAanZinslengten = WstatnTotaalAanZinslengten + nZinsLengte If ZinOverslaan Then GoTo 16999 If Not SyntacticAnalysis Then GoTo 16999 'Syntactische Behandeling afhankelijk van ingestelde schakelaar {zie begin macro] 'S Y N T A C T I S C H E B E H A N D E L I N G van de Zin: 'VortSpecEnFrazo-STRING van afgewerkte zin gaat naar Excel: With WstatWordtoExcel.worksheets(5) '[28-2-08: Worksheetnummer veranderd van 4 in 5 ] .Cells(1 + iZin, 1) = "'" & VortSpecEnFrazo1 'paragraaf- en zinsnummer .Cells(1 + iZin, 2) = "'" & VortSpecEnFrazo2 'VortSpecEnFrazo-STRING '**Tijdelijke Test met zichtbaarmaking Tekstwoorden op AZM-conforme woordposities [5 juni 2007]: 'For iTijdelijkeTest = 1 To 250 ' .Cells(iTijdelijkeTest, 3) = "" 'eerst schoonvegen (ivm duidelijkheid bij visualisering) 'Next iTijdelijkeTest 'For iTijdelijkeTest = 1 To jTekstWoord ' .Cells(iTijdelijkeTest, 3) = WoordOpWoordPositie(iTijdelijkeTest) 'Next iTijdelijkeTest 'einde TijdelijkeTest nZinsbouwEntries = nZinsbouwEntries + 1 End With If SyntaxSubjObjVerbPairs(iZin, VortSpecEnFrazo2, WoordPositiesSVO, ntrio) Then '[5 juni 2007]: 'MsgBox ("Zin " & iZin & ": Subj-Verb of Obj-Verb pair gevonden!") With WstatWordtoExcel.worksheets(6) 'SVO-Worksheet: '[7 juni 2007] 'Per zin kunnen meerdere SVO-trio's zijn opgespoord: For itrio = 1 To ntrio '------------------------------------------------------------------------------------------------------------------------------------------- SubjWoord = "" 'reset ObjWoord = "" 'reset VerbWoord = "" 'reset 'Header-Noun of Pronoun: 'Subject: 16910: If WoordPositiesSVO(itrio, 1) > 0 Then '(ELSE: geen Subject aanwezig) If Not WoordPositiesSVO(itrio, 1) > 9000 Then SubjWoord = WoordOpWoordPositie(WoordPositiesSVO(itrio, 1)) If Left(SubjWoord, 5) = "0000 " Then 'haal woord uit evt. Nulquatro-verpakking: SubjWoord = Right(SubjWoord, Len(SubjWoord) - 5) SubjWoord = Left(SubjWoord, Len(SubjWoord) - 5) End If If MontruSintaksEnFonto Then '[22-5-08] 'Highlighten van het Subject-Woord in de zin: If WoordPositiesSVO(itrio, 1) > nZinsLengte Then MsgBox "Error: WoordPositie-Subject overschrijdt zinslengte!" '[25-7-07] Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 1)) Selection.Range.HighlightColorIndex = wdBrightGreen '(SUBJECT => LICHT-GROENE highlighting) If Not (Right(SubjWoord, 1) = "o" Or Right(SubjWoord, 2) = "oj" Or Right(SubjWoord, 1) = "i") Then MsgBox ("Error: Subject without -o, -oj, -i") End If Else If WoordPositiesSVO(itrio, 1) = 9999 Then SubjWoord = "'?" '"unsure" outcome given by Function SyntaxSubjObjVerbPairs [7-7-07] If WoordPositiesSVO(itrio, 1) = 9001 Then SubjWoord = "" 'Infinitive-Object construction (no Subject present) End If End If 'Object: 16930: If WoordPositiesSVO(itrio, 3) > 0 Then '(ELSE: geen Object aanwezig) If Not WoordPositiesSVO(itrio, 3) > 9000 Then ObjWoord = WoordOpWoordPositie(WoordPositiesSVO(itrio, 3)) If Left(ObjWoord, 5) = "0000 " Then 'haal woord uit evt. Nulquatro-verpakking: ObjWoord = Right(ObjWoord, Len(ObjWoord) - 5) ObjWoord = Left(ObjWoord, Len(ObjWoord) - 5) End If If TempoDauroAkuzativo(ObjWoord) Then If SubjWoord = "" Then '[9-8-07] GoTo 1699 'skip registratie OV-paar, want het betreft een TIJDSDUUR-bepaling ipv een direct Object Else 'indien er een Subject is, dan alleen het SV-paar highlighten en registreren: '[9-8-07] ObjWoord = "" WoordPositiesSVO(itrio, 3) = 0 '[9-8-07] GoTo 16920 '[9-8-07] End If End If If Not WoordPositiesSVO(itrio, 1) = 9001 Then 'niet bij IO (Infinitiv-Object constructie) If MontruSintaksEnFonto Then '[22-5-08] 'Highlighten van het Object-Woord in de zin: If WoordPositiesSVO(itrio, 3) > nZinsLengte Then MsgBox "Error: WoordPositie-Object overschrijdt zinslengte!" '[25-7-07] Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 3)) Selection.Range.HighlightColorIndex = wdTurquoise '(OBJECT => LICHT-BLAUWE highlighting) If Not (Right(ObjWoord, 2) = "on" Or Right(ObjWoord, 3) = "ojn" Or Right(ObjWoord, 2) = "in") Then MsgBox ("Error: Object without -on, -ojn, -in") End If End If Else 'WoordPositiesSVO(itrio, 3) = 9999: ObjWoord = "'?" '"unsure" outcome given by Function SyntaxSubjObjVerbPairs [7-7-07] End If End If 'Werkwoord (Finite Verb): 16920: If WoordPositiesSVO(itrio, 2) = 0 Then 'GEEN Verb: If WoordPositiesSVO(itrio, 1) = 0 And WoordPositiesSVO(itrio, 3) = 0 Then 'LEEG trio: '[3-8-07] GoTo 16991 '[door SyntaxSubjObjVerbPairs wordt soms een "leeg" trio doorgegeven] '[3-8-07] Else MsgBox ("Error: GEEN Verb doorgegeven") End If Else 'Verb aanwezig: If WoordPositiesSVO(itrio, 1) = 0 And WoordPositiesSVO(itrio, 3) = 0 Then 'trio heeft ALLEEN Verb: '[3-8-07] GoTo 1699 '[een trio registreren met alleen Verb wordt niet zinvol geacht] '[3-8-07] End If End If VerbWoord = WoordOpWoordPositie(WoordPositiesSVO(itrio, 2)) If Left(VerbWoord, 5) = "0000 " Then 'haal woord uit evt. Nulquatro-verpakking: VerbWoord = Right(VerbWoord, Len(VerbWoord) - 5) VerbWoord = Left(VerbWoord, Len(VerbWoord) - 5) End If If Not WoordPositiesSVO(itrio, 1) = 9001 Then '(Finite Verb): 'Check of het Verb misschien een SenSubjekta Verb is (bijv. "pluvas"): '[9-8-07] If SenSubjektaVerbo(VerbWoord) Then 'MsgBox "SenSubjektaVerbo" 'Zorg nu dat een eventueel toch doorgegeven Subject (in zin als bijv. "Dum la somero pluvis multe, sed....") ... ' ... genegeerd wordt: If SubjWoord <> "" And MontruSintaksEnFonto Then 'haal gezette licht-groene highlighting weer weg: Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 1)) Selection.Range.HighlightColorIndex = wdNoHighlight End If 'Bij een SenSubjekta Verb wordt ook een evt. doorgegeven Object genegeerd: If ObjWoord <> "" And MontruSintaksEnFonto Then 'haal gezette blauwe highlighting weer weg: Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 3)) Selection.Range.HighlightColorIndex = wdNoHighlight End If GoTo 1699 '[een trio registreren met alleen Verb wordt niet zinvol geacht] '[3-8-07] End If If MontruSintaksEnFonto Then '[22-5-08] 'Highlighten van het Verb-Woord in de zin: If WoordPositiesSVO(itrio, 2) > nZinsLengte Then MsgBox "Error: WoordPositie-Verb overschrijdt zinslengte!" '[25-7-07] Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 2)) Selection.Range.HighlightColorIndex = wdGray25 '(VERB => LICHT-GRIJZE highlighting) If Not (Right(VerbWoord, 2) = "as" Or Right(VerbWoord, 2) = "is" Or Right(VerbWoord, 2) = "os" Or Right(VerbWoord, 2) = "us" Or Right(VerbWoord, 1) = "u") Then MsgBox ("Error: Verb without -as, -is, -os, -us, -u") End If 'If KopuloVerb(VerbWoord) Then GoTo 1699 'skip registratie OV-paar, want het betreft een Kopulo-verb (koppelwerkwoord) ipv een gewoon werkwoord Else 'Infinitiv+Object: If MontruSintaksEnFonto Then '[22-5-08] 'Highlighten van Infinitiv en Object in de zin: If WoordPositiesSVO(itrio, 2) > nZinsLengte Then MsgBox "Error: WoordPositie-Infinitiv overschrijdt zinslengte!" '[25-7-07] Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 2)) Selection.Range.HighlightColorIndex = wdGray50 '(Infinitive => DONKER-GRIJZE highlighting) If Not (Right(VerbWoord, 1) = "i") Then MsgBox ("Error: Infinitive without -i") If WoordPositiesSVO(itrio, 3) > nZinsLengte Then MsgBox "Error: WoordPositie-Object overschrijdt zinslengte!" '[25-7-07] Call ZetSelectieOpZinsWoord(WoordPositiesSVO(itrio, 3)) Selection.Range.HighlightColorIndex = wdDarkYellow '(Object => BRUIN-GELE highlighting) If Not (Right(ObjWoord, 2) = "on" Or Right(ObjWoord, 3) = "ojn" Or Right(ObjWoord, 2) = "in") Then MsgBox ("Error: Object without -on, -ojn, -in") End If End If 'Bepaling SVO-VOLGORDE (belangrijk bij registratie van SVO-trio's in Excel): If ListiguSintaksEnExcel Then If Not WoordPositiesSVO(itrio, 1) > 9000 Then If WoordPositiesSVO(itrio, 3) = 0 Then 'GEEN Object aanwezig: If WoordPositiesSVO(itrio, 1) = 0 Then SVOvolgorde = "V" '(ook GEEN Subject, bijv. 'pluvas' ) Else 'ALLEEN Subject-Verb PAAR: If WoordPositiesSVO(itrio, 1) < WoordPositiesSVO(itrio, 2) Then SVOvolgorde = "SV" Else SVOvolgorde = "VS" End If ElseIf WoordPositiesSVO(itrio, 1) > 0 Then 'Zowel Subject als Object aanwezig (SUBJECT-OBJECT-VERB- TRIO): If WoordPositiesSVO(itrio, 1) < WoordPositiesSVO(itrio, 2) Then 'Subject LINKS van Verb: If WoordPositiesSVO(itrio, 3) > WoordPositiesSVO(itrio, 2) Then 'Object RECHTS van Verb: SVOvolgorde = "SVO" Else 'Subject en Object BEIDEN LINKS van Verb: If WoordPositiesSVO(itrio, 3) > WoordPositiesSVO(itrio, 1) Then 'Object RECHTS van Subject: SVOvolgorde = "SOV" Else SVOvolgorde = "OSV" End If End If Else 'Subject RECHTS van Verb: If WoordPositiesSVO(itrio, 3) < WoordPositiesSVO(itrio, 2) Then 'Object LINKS van Verb: SVOvolgorde = "OVS" Else 'Subject en Object BEIDEN RECHTS van Verb: If WoordPositiesSVO(itrio, 3) < WoordPositiesSVO(itrio, 1) Then 'Object LINKS van Subject: SVOvolgorde = "VOS" Else SVOvolgorde = "VSO" End If End If End If Else 'Wel Object, maar GEEN Subject aanwezig (ALLEEN Object-Verb PAAR): If WoordPositiesSVO(itrio, 3) < WoordPositiesSVO(itrio, 2) Then SVOvolgorde = "OV" Else SVOvolgorde = "VO" '(bijv. 'interesas min, ke... ' ) End If ElseIf WoordPositiesSVO(itrio, 1) = 9999 Then SVOvolgorde = "'?V?" ElseIf WoordPositiesSVO(itrio, 1) = 9001 Then SVOvolgorde = "'InfObj" End If End If 'Registratie van SVO-trio's in Excel, in ESPSOF-REGREZ-Worksheet(6): If ListiguSintaksEnExcel Then iSVOlijst = iSVOlijst + 1 .Cells(iSVOlijst, 1) = "'" & VortSpecEnFrazo1 'paragraaf- en zinsnummer .Cells(iSVOlijst, 2) = "'" & SubjWoord 'registratie Subject (Header-Noun of Pronoun) '[25 juni 2007] .Cells(iSVOlijst, 3) = "'" & VerbWoord 'registratie Finite Verb .Cells(iSVOlijst, 4) = "'" & ObjWoord 'registratie Object (Header-Noun of Pronoun) '[25 juni 2007] 'If SVOvolgorde <> "SVO" Then .Cells(iSVOlijst, 5) = SVOvolgorde 'aanduiding onderlinge volgorde van S, V en O (voor Taal-Statististiek) 'End If If Not PretiguExcelAutomate Then iRegelInSVOlijst = iRegelInSVOlijst + 1 If iRegelInSVOlijst = 32 Then 'Excel window automatisch omhoogscrollen '.Cells(iSVOlijst, 3).Select '[17-5-08:] veroorzaakte Run time Error 1004: "Select method of Range class failed" 'If WstatWordtoExcel.Worksheets(6).Visible Then '[23-5-08: was ook bedoeld om Error 1004 te voorkomen, maar werkte niet] On Error Resume Next '[26-5-08] .Cells(iSVOlijst, 1).Select '[17-5-08:] (iSVOlijst,1) ipv (iSVOlijst,3) voorkomt Error 1004; If Err.number = 1004 Then '[26-5-08] voorkomt Error 1004 bij Invisible Excel-file of bij niet geopend SVO-Worksheet Err.Clear '[26-5-08] End If 'End If 'ActiveWindow.SmallScroll Down:=32 [** < onjuist (werkt zich uit op WORD- ipv Excel-Window ! ] iRegelInSVOlijst = 0 End If End If End If 1699: WoordPositiesSVO(itrio, 1) = 0 'SUBJECT (reset) WoordPositiesSVO(itrio, 2) = 0 'VERB (reset) WoordPositiesSVO(itrio, 3) = 0 'OBJECT (reset) 16991: nSVOentries = nSVOentries + ntrio '[12-2-2008] '(telling van het totale aantal SVO-lijst-entries op Excel-Worksheets(6) Next itrio '------------------------------------------------------------------------------------------------------------------------------------------------------- End With End If 16999: ZinBegintMetHaltoStreko = False '[24-5-08] reset 'If iZin = 5 Or iZin = 10 Or iZin = 100 Or iZin = 1000 Or iZin = 5000 Or iZin = 10000 Then 'If MsgBox("EINDE van zin " & WstatnAantalZinnen & ", doorgaan naar volgende?", vbYesNo) = vbNo Then GoTo 666 'End If 'Call ZetSelectieOpZinsWoord(jTekstWoord) 'hier jTekstWoord = nZinsLengte (laatste woord van zin) 'Selection.Collapse direction:=wdCollapseEnd 17000: '[22-2-2008] Next iZin 'ONDER-EIND VAN BUITENLUS 'FINO de GRANDA ITERACIO TRA ĈIUJ (AZM- / KomencMarkitaj-) FRAZOJ DE LA TEKST-DOSIERO: 'Selection.Collapse 'Selection.GoTo what:=wdGoToLine, Which:=wdGoToFirst, Count:=1, Name:="" 'cursor aan begin file zetten '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 Footnote-gedeelte geselecteerd Selection.Collapse direction:=wdCollapseStart ElseIf EndnotesBeingProcessed Then ActiveDocument.StoryRanges(wdEndnotesStory).Select 'hierdoor wordt het Endnote-gedeelte geselecteerd Selection.Collapse direction:=wdCollapseStart End If 666: 'EINDE van document bereikt - EINDBEHANDELING: 'MsgBox "Einde van document bereikt - Eindbehandeling" End With If Not TekstoKajNotojAparte Then '[27-12-08] If ActiveDocument.Footnotes.Count >= 1 And Not FootnotesBeingProcessed Then ActiveDocument.StoryRanges(wdFootnotesStory).Select 'hierdoor wordt het Footnotes-deel geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat het hele Footnotes-deel "zwart" wordt nMordisTekens = 0 nAantalAlineas = nAantalAlineas + 1 FootnotesBeingProcessed = True '[5-1-09] MainText = False '[9-1-09] GoTo 10000 'verwerk nu de gezamenlijke FOOTNOTES, net zoals de main text verwerkt werd End If If ActiveDocument.Endnotes.Count >= 1 And Not EndnotesBeingProcessed Then ActiveDocument.StoryRanges(wdEndnotesStory).Select 'hierdoor wordt het Endnotes-deel geselecteerd Selection.Collapse direction:=wdCollapseStart 'dit voorkomt dat het hele Endnotes-deel "zwart" wordt nMordisTekens = 0 EndnotesBeingProcessed = True '[5-1-09] MainText = False '[30-1-09] FootnotesBeingProcessed = False '[9-1-09] GoTo 10000 'verwerk nu de gezamenlijke ENDNOTES, net zoals de main text verwerkt werd End If End If EndProcessing = Timer ProcessingTime = EndProcessing - StartProcessing '[28-1-09] 'Wanneer StartProcessing voor 24.00 uur 's nachts is en EndProcessing daarna, dan: 'If ProcessingTime < 0 Then ProcessingTime = 24 * 3600 - ProcessingTime '[28-1-09: leidde tot Overflow bij EndProcessing na middernacht] If ProcessingTime < 0 Then ProcessingTime = (24 - ProcessingTime / 3600) * 3600 '[30-1-09] 'er wordt hierbij vanuit gegaan dat de totale verwerkingstijd MINDER DAN 24 UUR is '[28-1-09] 'EIND-afhandeling: 'Sorteringen (op woordsoort, op AbsFreq, etc) moeten worden gedaan via Excel, waar ook de presentatie van woordstatistische ... ' ... gegevens aan de gebruiker plaats vindt (Excel is meer ge-eigend om zeer grote arrays snel presentabel te maken, ook in de vorm van grafieken). 'Samenvattende algemene gegevens: With WstatWordtoExcel.worksheets(1) .Cells(1, 1).Value = "nombro de kontrolitaj frazoj:" .Cells(2, 1).Value = "nombro de aperoj de lingvaj vortoj en la teksto (inkl. 'frazkomencajn majusklajn vortojn'):" .Cells(3, 1).Value = "nombro de aperoj de propraj nomoj en la teksto (inkl. 'frazkomencajn majusklajn vortojn'):" .Cells(4, 1).Value = "nombro de aperoj de 'adresvortoj' en la teksto:" .Cells(5, 1).Value = "nombro de aperoj de 'cifervortoj' en la teksto:" .Cells(6, 1).Value = "nombro de aperoj de 'signovortoj' en la teksto:" .Cells(7, 1).Value = "nombro de transsaltitaj vortoj (ekz. kursivaj): " .Cells(8, 1).Value = "Totalo de lingvaj vortoj + propraj nomoj + 'adresvortoj' + 'cifervortoj' + 'signovortoj' = " .Cells(9, 1).Value = "Totalo de trovitaj kaj rughigitaj eraroj (misskriboj, ne-ekzistantaj au fremdaj vortoj) =" .Cells(11, 1).Value = "nombro de aperoj de 'ne-enPIVaj kunmetajhoj' en la teksto:" .Cells(12, 1).Value = "nombro de aperoj de 'frazkomencaj majusklaj vortoj' en la teksto:" .Cells(13, 1).Value = "nombro de aperoj de necertaj, duonrughigitaj eraroj (en 'frazkomencaj majusklaj vortoj'):" '.Cells(14, 1).Value = "nombro de vortoj el kiuj 'sovaghaj majuskloj' estas forigitaj:" .Cells(1, 8).Value = WstatnAantalZinnen .Cells(2, 8).Value = WstatnTaalWoord .Cells(3, 8).Value = WstatnEigennaam .Cells(4, 8).Value = nRetadreso .Cells(5, 8).Value = WstatnCijferWoord .Cells(6, 8).Value = nLeestekenWoord nOverspringInter = nOverspringInter1 + nOverspringInter2 + nOverspringInter3 + nOverspringInter4 + nOverspringInter5 .Cells(7, 8).Value = nOverspringCursief + nOverspringTutmajuskl + nOverspringInter .Cells(8, 8).Value = WstatnTaalWoord + WstatnEigennaam + nRetadreso + WstatnCijferWoord + nLeestekenWoord .Cells(8, 9).Value = WstatnTotaalAanZinslengten - (nOverspringCursief + nOverspringTutmajuskl + nOverspringInter) 'ter controle .Cells(9, 8).Value = nFoutOfFremdWoord .Cells(11, 8).Value = nNeEnvortaraKunmeto .Cells(12, 8).Value = WstatnUnmarkedCap 'frazkomencaj majusklaj vortoj', 'citaĵkomencaj majusklaj vortoj', ktp. .Cells(13, 8).Value = nHalfFoutOfFremdWoord 'necertaj, duonruĝigitaj eraroj (en 'frazkomencaj majusklaj vortoj') '.Cells(14, 8).Value = nWoordWildeHoofdlettersWeg .Cells(1, 11).Value = BrontekstFilenaam '.Cells(2, 11).Value = If AnkauDict3 Then '[30-1-09] .Cells(3, 11).Value = "Opcio I (tuta PIV kaj aldona ESPSOF-vortaro)" ElseIf TutaPIV Then: .Cells(3, 11).Value = "Opcio II (tuta PIV)" ElseIf GenVoc16only Then: .Cells(3, 11).Value = "Opcio III (nur " & ChrW(265) & "iutagaj kaj oficialaj vortoj el PIV)" ElseIf BROonly Then: .Cells(3, 11).Value = "Opcio IV (Baza Radikaro Oficiala)" End If If AnkauPrivatVortaro Then .Cells(4, 11).Value = "anka" & ChrW(365) & " PrivatVortaro" Else .Cells(4, 11).Value = "" End If .Cells(16, 1).Value = "komputiltempo de plenumo (sekundoj):" .Cells(17, 1).Value = "nVortarkonsultoj, nPozitiv, nNegativ: " '[nOproepCheckEspWord, nPositiveDictSearches, nNegativeDictSearches] .Cells(18, 1).Value = "nEOf-kazoj, nEOf-plibonigoj, nEOf-plibonigfiaskoj:" '[nEOf, nEOfUpgrade, nEOfUpgradeFailed] .Cells(19, 1).Value = "nEBO-ambiguoj:" '[WstatnNulEntry] .Cells(16, 6).Value = ProcessingTime: .Cells(16, 6).NumberFormat = "0" '(geen cijfers achter de komma) .Cells(17, 6).Value = nOproepCheckEspWord & " , " & nPositiveDictSearches & " , " & nNegativeDictSearches '(respektive: nombro de vortarkonsultoj, nombro de sukcesaj kaj nombro de malsukcesaj folio- aŭ kolumno-traserĉoj) .Cells(18, 6).Value = nEOf & " , " & nEOfUpgrade & " , " & nEOfUpgradeFailed .Cells(19, 6).Value = WstatnNulEntry 'Voor snel oppakken door Excel-macros worden ook de LENGTES van verschillende lijsten doorgegeven [30-1-2007]: .Cells(21, 1).Value = "Komencpozicioj kaj longoj de listoj:" .Cells(22, 1).Value = " LingvVortListo:" .Cells(23, 1).Value = " ProprNomListo:" .Cells(24, 1).Value = " KunmetAnalizo:" .Cells(25, 1).Value = " VortspecEnFrazListo:" .Cells(26, 1).Value = " SVO-Listo:" .Cells(27, 1).Value = " AdresVortListo:" .Cells(28, 1).Value = " CiferVortListo:" .Cells(29, 1).Value = " SignoVortListo:" .Cells(30, 1).Value = " InterpunkciFu" & ChrW(349) & "FrazListo:" 'Beginposities (beginrijen): .Cells(22, 3).Value = 2 'TaalwoordenLijst: .Cells(23, 3).Value = 2 'EigennaamLijst .Cells(24, 3).Value = 4 'KunmetAnaliz .Cells(25, 3).Value = 2 'ZinsbouwLijst .Cells(26, 3).Value = 2 'SVO-Lijst .Cells(27, 3).Value = 131 'RetAdresoLijst .Cells(28, 3).Value = 131 'CijferWoordLijst .Cells(29, 3).Value = 131 'LeestekenWoordLijst .Cells(30, 3).Value = 131 'Lijst van zinnnen (aangegeven met Alinea- en Zinnummer) waarin niet-analiseerbare tekenreeksen staan: 'de zgn. "InterpunkciFuŝFrazListo"; deze zinnen kunnen NIET (syntaktisch) geanaliseerd worden 'LijstLengtes (aantal rijen): .Cells(22, 4).Value = WstatnLijstWoord .Cells(23, 4).Value = WstatnLijstEigennaam '.Cells(24, 4).Value = ... 'KunmetAnaliz .Cells(25, 4).Value = nZinsbouwEntries .Cells(26, 4).Value = nSVOentries .Cells(27, 4).Value = nRetadreso .Cells(28, 4).Value = WstatnCijferWoord .Cells(29, 4).Value = nLeestekenWoord .Cells(30, 4).Value = nSkipped 'Aanduiding waar Lijst staat: .Cells(22, 5).Value = " (vidu Laborfolion 2)" .Cells(23, 5).Value = " (vidu Laborfolion 3)" .Cells(24, 5).Value = " (vidu Laborfolion 4)" .Cells(25, 5).Value = " (vidu Laborfolion 5)" .Cells(26, 5).Value = " (vidu Laborfolion 6)" .Cells(27, 5).Value = " (vidu Laborfolion 1, vico 130, kolumno B )" .Cells(28, 5).Value = " (vidu Laborfolion 1, vico 130, kolumno F )" .Cells(29, 5).Value = " (vidu Laborfolion 1, vico 130, kolumno J )" .Cells(30, 5).Value = " (vidu Laborfolion 1, vico 130, kolumno N )" 'Detaillering van het aantal Oversprongen (niet-gecontroleerde) woorden [19-4-2008]: .Cells(33, 1).Value = "Nombroj de transsaltitaj vortoj (lau speco):" .Cells(34, 1).Value = "kursivaj vortoj:" .Cells(35, 1).Value = "TUTMAJUSKLAJ vortoj:" .Cells(36, 1).Value = "vortoj 'inter' simplaj apostrofoj:" .Cells(37, 1).Value = "vortoj ''inter'' duoblaj apostrofoj:" .Cells(38, 1).Value = "vortoj [inter] rektaj krampoj:" .Cells(39, 1).Value = "vortoj angulaj krampoj:" .Cells(40, 1).Value = "vortoj inter aliaj specifaj signoj:" .Cells(40, 5).Value = " (Inter5Speco = " & Inter5Speco & " )" '[26-5-08] 'Aantallen: .Cells(34, 3).Value = nOverspringCursief .Cells(35, 3).Value = nOverspringTutmajuskl .Cells(36, 3).Value = nOverspringInter1 .Cells(37, 3).Value = nOverspringInter2 .Cells(38, 3).Value = nOverspringInter3 .Cells(39, 3).Value = nOverspringInter4 .Cells(40, 3).Value = nOverspringInter5 'Tabelo pri Distribuo de Vortlongeco (nur pri lingvaj vortoj): [23-12-08] .Cells(70, 1).Value = "Distribuo de vortlongoj (nur pri lingvaj vortoj):" For i = 2 To 50 .Cells(70 + i, 1).Value = i If WoordLengte(i) <> 0 Then .Cells(70 + i, 2).Value = WoordLengte(i) 'totaal aan woorden met woordlengte i Next i 'Eind-Berekening van gemiddelde taalwoord-lengte: If nTotaalAantalTaalWoorden > 0 Then '(gemiddelde taalwoord-lengte wordt uitsluitend berekend over de NIET-FOUTE taalwoorden [26-1-09]) GemiddeldeWoordlengte = WstatnTotaalTaalWoordlengten / nTotaalAantalTaalWoorden Else: GemiddeldeWoordlengte = 0 End If If nTotaalAantalTaalWoorden > 1 Then '(standaard deviatie taalwoord-lengte wordt uitsluitend berekend over de NIET-FOUTE taalwoorden [26-1-09]) StdDeviatieWoordlengte = Sqr(WstatnTotaalKwadrWoordlengten - (nTotaalAantalTaalWoorden * GemiddeldeWoordlengte * GemiddeldeWoordlengte)) / (nTotaalAantalTaalWoorden - 1) Else: StdDeviatieWoordlengte = 0 End If 'Vaststellen langste taalwoord-lengte: For i = 50 To 2 Step -1 If WoordLengte(i) <> 0 Then GoTo 9877 Next i 9877: taalwlenmax = i 'taalwlenmax is de langste taalwoord-lengte die voorkomt in de tekst 'Bijschrijven bij lijst: .Cells(70, 5).Value = "meza vortlongo = " .Cells(71, 5).Value = "varianca devio = " .Cells(72, 5).Value = "maksimuma longo = " .Cells(70, 7).Value = (Int((10 * GemiddeldeWoordlengte) + 0.5)) / 10 'GemiddeldeWoordlengte, met 1 decimaal achter de komma .Cells(71, 7).Value = (Int((10 * StdDeviatieWoordlengte) + 0.5)) / 10 'StdDeviatieWoordlengte, met 1 decimaal achter de komma .Cells(72, 7).Value = taalwlenmax 'Verder (meer naar onderen) op Sheet 1 nog enkele resterende gegevens, mede voor test-doeleinden: .Cells(130, 1).Value = "AdresVortListo:" For i = 1 To nRetadreso 'Retadreso-woorden, onderaan links in sheet 1: If i > 250 Then Exit For .Cells(130 + i, 1).Value = RetadresoOpslag(i) Next i '[250 is ingestelde max arraylengte; nRetadreso kan hoger zijn] .Cells(130, 5).Value = "CiferVortListo:" For i = 1 To WstatnCijferWoord 'Cijfer-woorden, onderaan rechts in sheet 1: If i > 750 Then Exit For '[16-11-06] .Cells(130 + i, 6).Value = "'" & CijferWoordOpslag(i) 'toevoeging apostrofe ter vermijding van Excel-conversie van bijv. "2-3" naar "03 Feb" Next i '[750 is ingestelde max arraylengte; WstatnCijferWoord kan aanmerkelijk hoger zijn] .Cells(130, 9).Value = "SignoVortListo:" For i = 1 To nLeestekenWoord 'LeestekenWoorden, onderaan verder rechts in sheet 1: If i > 250 Then Exit For '[16-11-06] If Left(LeestekenWoordOpslag(i), 1) = "=" Then LeestekenWoordOpslag(i) = "'" & LeestekenWoordOpslag(i) '[13-3-2008] .Cells(130 + i, 10).Value = LeestekenWoordOpslag(i) Next i '[250 is ingestelde max arraylengte; nLeestekenWoord kan aanmerkelijk hoger zijn] .Cells(130, 13).Value = "InterpunkciFu" & ChrW(349) & "FrazListo:" '[16-1-09; zie ook boven label 120] '[dit betreft de gevallen: "Tro da strangaj (interpunkciaj) signoj en tiu chi frazo: ghi NE estos (sintakse) analizita !"] For i = 1 To nSkipped 'textAlineaZinsnummers, onderaan nog verder rechts in sheet 1: .Cells(130 + i, 14).Value = "'" & SkippedSentences(nSkipped) '[voorafgaande apostrof voorkomt convertering AlineaZins-nummers naar kalenderdata] Next i '[50 is ingestelde max arraylengte; het aantal Skipped Sentences kan hoger zijn] End With 'MsgBox "Nieuwe Woordstatistiek nu ingevuld in EXCEL" & vbCr & vbCr & _ ' "gebruik het Excel-programma voor presentatie en verdere bewerkingen" 'INDELING EXCEL-WORKBOOK: 'Op Sheet 1 van de Excel-file staat nu het Overzicht van de Samenvattende algemene gegevens (en vanaf rij 130 secundaire data). 'De TaalwoordLijst in Sheet 2 (met haar waardevolle 2e en 3e kolom waarin resp. woordsoort-teken en AbsFreq) ... 'is (Esp.-)alfabetisch gesorteerd. Er komen GEEN hoofdletters of "dubbele" entries in voor. 'De Eigennaamlijst is (standaard-)alfabetisch gesorteerd en staat in worksheet 3 van de Excel-file. 'Uiterst rechts (kolommen EY - FP) in worksheet 4 is de ANEK-'kladbloc' (Analizilo de Ne-Envortaraj Kunmetoj) te zien. 'De VortSpecEnFrazo-STRINGS (taalkundige ontledingen van elke zin) staan in worksheet 5 van de Excel-file. 'Indien dezelfde BrontekstFile een aantal keren achtereen (na evt. wijzigingen) door EspTekstAnalizilo ge-analyseerd wordt,.. '...zal de naam van de resulterende Excel file telkens met een opgehoogd quasi-versienummer veranderd worden: If BrontekstFilenaam = CurrentBronTekstFilenaam Then IncrementRezultTekstFilenaam = IncrementRezultTekstFilenaam + 1 Else IncrementRezultTekstFilenaam = 1 End If 'bij deze naamgeving wordt gewerkt met 2 'statische' variabelen binnen de Procedure EspTekstAnalizilo: 'Private CurrentBronTekstFilenaam As String 'Private IncrementRezultTekstFilenaam As Integer RezultMapNaam = "C:\ESPSOF\REZULTOJ\" 'default '[biedt de gebruiker t.z.t. aan om ZELF een map te kiezen!] 'MsgBox "Excel file wordt gesaved als: " & vbCr & vbCr & _ ' RezultMapNaam & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls" 'Bewerking Brontekst-File nu evt. afsluiten met ONZICHTBAAR maken van AZM-Fieldcodes: 'ActiveDocument.ActiveWindow.View.ShowFieldCodes = False '[dit is NIET raadzaam; want als ze niet zichtbaar zijn zal de gebruiker vergeten dat ze er zijn, en dat hij er rekening mee moet houden] '[de gebruiker kan ze desgewenst weer zichtbaar maken via Tools-Options-View-FieldCodes] 'EindMsgBox: If PretiguExcelAutomate Then MsgBox "Tuta tekstdosiero nun analizita:" & vbCr & vbCr & _ "kontrolitaj frazoj: " & WstatnAantalZinnen & vbCr & _ "kontrolitaj vortoj: " & WstatnTaalWoord + WstatnEigennaam + nRetadreso + WstatnCijferWoord + nLeestekenWoord & _ " (de kiuj " & nNeEnvortaraKunmeto & " estas Ne-Envortaraj Kunmetajhoj)" & vbCr & vbCr & _ " trovitaj eraroj: " & nFoutOfFremdWoord & vbCr & vbCr & vbCr & _ "Pli detalaj analiz-rezultoj en Excel-dosiero: " & vbCr & vbCr & _ RezultMapNaam & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls", _ Title:="EspKONTR.TEKSTAnal" '[22-10-08] Else 'If "Mi Mem Prizorgis": MsgBox "Tuta tekstdosiero nun analizita:" & vbCr & vbCr & _ "kontrolitaj frazoj: " & WstatnAantalZinnen & vbCr & _ "kontrolitaj vortoj: " & WstatnTaalWoord + WstatnEigennaam + nRetadreso + WstatnCijferWoord + nLeestekenWoord & _ " (de kiuj " & nNeEnvortaraKunmeto & " estas Ne-Envortaraj Kunmetajhoj)" & vbCr & vbCr & _ " trovitaj eraroj: " & nFoutOfFremdWoord & vbCr & vbCr & vbCr & _ "Pli detalaj analiz-rezultoj en Excel-dosiero: " & vbCr & vbCr & EspsofREGREZ, _ Title:="EspKONTR.TEKSTAnal" '[30-1-09] End If With WstatWordtoExcel 'GoTo 62010 '[ SKIP i n t e s t v e r s i e 26-3-2008] .SaveCopyAs filename:=RezultMapNaam & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls" '.SaveCopyAs FileName:="D:\Mijn Documenten\" & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls" 'De file "ESPSOF-REGREZ" was al eerder - met de hand - geopend en kan geminimaliseerd zijn in de Taakbalk ... ' ... of zichtbaar gemaakt zijn in een window, om de opbouw van bijv. de TaalwoordLijst tijdens de werking van EspTekstAnalizilo gade te slaan. 'Door SaveCopyAs wordt de inhoud opgeslagen in een Excel-file met dezelfde naam als de Brontekstfile, en deze nieuwe file belandt in ... ' ... de standaard-map "C:\ESPSOF\REZULTOJ". Indien evt. volgende runs van EspTekstAnalizilo dezelfde (gewijzigde) Brontekstfile betreffen, wordt automatisch ... ' ... gezorgd voor een versienummer in de resulterende Excel-file. 'De standaard-file "ESPSOF-REGREZ" wordt hieronder, aan het eind van macro EspTekstAnalizilo, schoongeveegd, ... ' ... voor opnieuw gebruik bij een evt. volgende run van de Espsof TekstAnalizilo. ' 62010: If PretiguExcelAutomate Then 'in automatische versie (eerder genoemd 'STILLE'-VERSIE): 'Snelle manier van schoonvegen van file ESPSOF-REGREZ: '[12-2-2008] For i = 8 To 10 'SCHOONVEGEN kolommen H, I en J van Worksheet 1: '[29-2-08] .worksheets(1).Columns(i).ClearContents 'Overzicht Next i .worksheets(1).Cells(130, 9).Value = "SignoVortListo:" '(herstel kopje) For i = 2 To 6 Step 2 'SCHOONVEGEN kolommen B, D en F van Worksheet 1: '[29-2-08] .worksheets(1).Columns(i).ClearContents 'Overzicht Next i For i = 1 To 12 'SCHOONVEGEN 12 kolommen A t/m L) van vier andere Worksheets: '[10-2-07] .worksheets(2).Columns(i).ClearContents 'Taalwoorden .worksheets(3).Columns(i).ClearContents 'Eigennamen 'Worksheets(4) 'wordt schoongeveegd door macro KunmetAnaliz' .worksheets(5).Columns(i).ClearContents 'Zinsbouw .worksheets(6).Columns(i).ClearContents 'S-V-O Next i .worksheets(3).Columns(27).ClearContents 'PropNamSequence [27-3-08] .worksheets(3).Columns(28).ClearContents 'PropNamSequence [27-3-08] EspsofExcel.Activeworkbook.Close False 'close file '[27-4-08] 'werkt alleen op REGREZ (laatstelijk actief), niet op Vortar; EspsofExcel.Workbooks(1).Close False 'close file '[27-4-08] 'is nodig om vervolgens ook VORTAR te sluiten '[de parameter 'False' in bovenstaande 2 stmts slaat op: SaveChanges:=xlDoNotSaveChanges] EspsofExcel.Quit '[9-5-08] (belangrijk is dat een INVISIBLE Excel-applicatie NIET blijft bestaan: ... ' ...kan onbedoeld een verborgen "val" worden voor nieuw op te starten Excel-files!) 'De hierboven reeds gesavede Resultaatsfile wordt nu geopend en zichtbaar gemaakt, om door de gebruiker bekeken te kunnen worden: Set EspsofExcel = CreateObject("Excel.Application") 'er wordt een nieuwe instantie van Excel klaargezet EspsofExcel.Visible = True EspsofExcel.Workbooks.Open RezultMapNaam & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls" EspsofExcel.Workbooks(1).worksheets(2).Activate 'deze en de volgende 3 stmts zorgen ervoor dat het Workbook bij opening ... EspsofExcel.Workbooks(1).worksheets(2).Cells(1, 1).Activate ' ... op een ordelijke manier verschijnt EspsofExcel.Workbooks(1).worksheets(1).Activate EspsofExcel.Workbooks(1).worksheets(1).Cells(1, 1).Activate EspsofExcel.ActiveWindow.WindowState = 2 '[9-5-08] 2 = xlMaximize: parameterwaarde om File-window maximized (vullend) te maken binnen het Excel-window 'Om ook vanit de macro's MontruMorDisEnVorto, VariiguMorDisEnVorto,... toegang tot de automatisch geprodueerde Resultaatsfile mogelijk te maken: Set WstatWordtoExcel = GetObject(RezultMapNaam & BrontekstFilenaam & " " & CStr(IncrementRezultTekstFilenaam) & ".xls") '[26-5-08] End If End With 'Set WstatWordtoExcel = Nothing 'deze macro sluit het kanaal naar Excel weer af '[26-5-08:] dus NIET afsluiten, want dat blokkert toegang via MontruMorDisEnVorto etc. CurrentBronTekstFilenaam = BrontekstFilenaam 'BronTekstFilenaam wordt via Statische variabele doorgegeven aan evt. volgende EspTekstAnalizilo-oproep... '...om te checken of die oproep een volgende "versie" van TekstAnalyse van dezelfde BronTekstFile bevat If Not PretiguExcelAutomate Then 'in handmatige versie (voor herhaald gebruik, door insiders), waarbij de standaard-files REGREZ en VORTAR gehandhaafd blijven: '[evt. skippen in Testversie; 26-3-08]: If MsgBox("La tekstkontrolo finighis." & vbCr & vbCr & _ "ESPSOF metis FrazKomencMarkojn en vian fontotekston ;" & vbCr & _ "chu F O R V I S H I tiujn ?" & vbCr & vbCr & _ "Respondu 'Yes', se vi intencas ankorau shanghi la tekstdosieron.", vbYesNo, "EspKONTR.TEKSTAnal") = vbYes Then 'in BronTekstfile alle AZM-fields weer weghalen: ActiveDocument.ActiveWindow.View.ShowFieldCodes = True '(het zichtbaar zijn van de Fields is een voorwaarde voor het kunnen weghalen!) '[12-2-2008] 'MainText: If ActiveDocument.StoryRanges(wdMainTextStory).Fields.Count >= 1 Then ActiveDocument.StoryRanges(wdMainTextStory).Select 'hierdoor wordt het Gewone Tekstgedeelte geselecteerd Selection.Collapse direction:=wdCollapseStart 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 End If 'Evt. Footnotes: If ActiveDocument.Footnotes.Count >= 1 Then ActiveDocument.StoryRanges(wdFootnotesStory).Select 'hierdoor worden de Footnotes geselecteerd Selection.Collapse direction:=wdCollapseStart 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 End If 'Evt. Endnotes: If ActiveDocument.Endnotes.Count >= 1 Then ActiveDocument.StoryRanges(wdEndnotesStory).Select 'hierdoor worden de Endnotes geselecteerd Selection.Collapse direction:=wdCollapseStart 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 End If End If End If '----------------------------------- 999: JustFinishedTekstKontrol = True GoTo 9999 '++++++++++++QUASI-SUBROUTINE++++++++++ (Snelheidsverhogend) BINAIR ZOEK- en INSERTIE-proces+++++++++++[29-11-05; 28-1-08]: 70000: 'Ingang TAALWOORDEN (tekst-TaalwoordLijst) '[Eigennamen gaan via ingang 70001 ] 'MATCH- en INSERT-proces: '[29-11-05} hieronder is alles overgenomen uit het macro 'MatchEnkelEspWordToDictionary' [labels geprefigeerd met 77], 'behalve het key-naar-keynh reductie; in het tekst-Woordlijst-stadium willen we NIET met ... ' ... weggehaalde hyphens opereren, maar juist de hyphens laten staan, om onderscheid te maken tussen ' ... tekstwoorden met en zonder hyphen (denk aan konkludo vs. konk-ludo). key = TekstWoord If Hoofdletter(Left(key, 1)) Then key = BeginHoofdletterWeg(key) 'evt. beginhoofdletter wordt weggehaald low = i1 ' i1 = Begin van tekst-WoordLijst high = Iend 'Iend = Einde van tekst-WoordLijst MatchPos = 0 'Op de tekst-TaalwoordLijst is de ESP-DICT-SORTERING (ipv Excel-sortering) van toepassing: iKritChar = 1 For iChar = 1 To Len(key) 'Vector van Kritische Character-Posities wordt opgesteld: k = AscW(Mid(key, iChar, 1)) If k = 99 Then KritCharPos(2, iKritChar) = 265: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 103 Then: KritCharPos(2, iKritChar) = 285: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 104 Then: KritCharPos(2, iKritChar) = 293: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 106 Then: KritCharPos(2, iKritChar) = 309: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 115 Then: KritCharPos(2, iKritChar) = 349: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 117 Then: KritCharPos(2, iKritChar) = 365: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If If Not k > 122 Then GoTo 70010 If k = 265 Then KritCharPos(2, iKritChar) = 99: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 285 Then: KritCharPos(2, iKritChar) = 103: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 293 Then: KritCharPos(2, iKritChar) = 104: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 309 Then: KritCharPos(2, iKritChar) = 106: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 349 Then: KritCharPos(2, iKritChar) = 115: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 365 Then: KritCharPos(2, iKritChar) = 117: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If 70010: '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) Next iChar nKritChar = iKritChar - 1 'nKritChar = aantal kritische characterposities in zoekwoord, namelijk die... '...waarop een 'kritisch character' staat: c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ; 'De Kritische-Character-Positie-Vector heeft nKritChar kolommen van elk 2 integerwaarden: 'de eerste geeft de letterpositie in het woord aan, 'de tweede geeft het Unicode-nummer van het Complementaire Teken aan (waarbij bijv. s complementair is met ŝ ) 'indien nKritChar=0 dan heeft het zoekwoord een 'Nulvector' (geen kritische tekens, bijv. 'tablo', 'prezidento', ...): If nKritChar = 0 Then Nulvector = True Else Nulvector = False GoTo 77100 ' ----------------------- 70001: 'ingang EIGENNAMEN (tekst-EigennaamLijst) '[Taalwoorden gaan via ingang 70000 ] key = TekstWoord 'evt. beginhoofdletter blijft behouden low = i1Eigennaam ' i1Eigennaam = Begin van EigennaamLijst high = IendEigennaam 'IendEigennaam = Einde van EigennaamLijst MatchPos = 0 'Op de tekst-EigennaamLijst is de gewone Excel-sortering van toepassing. Nulvector = True '[28-1-2008] '---------------------------------------------------- op basis van Binary Search algorithme [see Tanenbaum, p. 305-307]: ---------------------------------------------------------------------- 77100: With WstatWordtoExcel 77101: If low = high Then 'Zoekrange geheel ingezoomd (nu Matchen of Inserten): middle = low If key = .worksheets(Wsh).Cells(low, 2).Value Then 'Match: MatchPos = middle 'MsgBox "match! TaalWoordLijst- of EigennaamLijst-positie = " & MatchPos GoTo 77700 Else InsertPos = middle NowInserting = True 'hier plaats voor insertie vrijmaken [de insertie van nieuwe woordgegevens zelf gebeurt onder label 700], ... ' ... eerst bepalen of de insertie VOOR of NA de cel met 'InsertPos=middle' moet plaatsvinden: GoTo 77250 77151: 'key < lijstwoord, dus VOOR de cel met 'InsertPos=middle': '.Worksheets(Wsh).Range(.Worksheets(Wsh).Cells(InsertPos, 2), .Worksheets(Wsh).Cells(InsertPos, Rkolom)).Insert 'Shift:=xlDown [dit "commentaar" geeft de default-shift aan, maar explicitering ervan leidt tot falen!!*] GoTo 77255 '[* = Runtime Error 1004: Insert method of Range class failed ] 77152: 'key > lijstwoord, dus NA de cel met 'InsertPos=middle': InsertPos = InsertPos + 1 '[* = Runtime Error 1004: Insert method of Range class failed ] '.Worksheets(Wsh).Range(.Worksheets(Wsh).Cells(InsertPos, 2), .Worksheets(Wsh).Cells(InsertPos, Rkolom)).Insert 'Shift:=xlDown [dit "commentaar" geeft de default-shift aan, maar explicitering ervan leidt tot falen!!*] 77255: If MetEigennaamBezig Then InsertPosEigennaam = InsertPos GoTo 700 'Uitgang bij GEEN Match Else GoTo 700 'Uitgang bij GEEN Match End If End If ElseIf low < high Then '[* misschien is het ivm Insertie beter om altijd naar boven af te ronden?] middle = (low + high) / 2 'Deel zoekrange op in twee helften (afronding middenpositie soms naar boven soms naar beneden): NowInserting = False 77250: lijstwoord = .worksheets(Wsh).Cells(middle, 2).Value If MetEigennaamBezig Then 'de Eigennaamlijst wordt volgens GEWONE alfabetische SORTERING opgebouwd (NIET volgens speciale Esp-dict sortering) KorG = StrComp(key, lijstwoord, vbTextCompare) 'hierbij komt bijv. "Ĉinio" VOOR "Cezaro" te staan in de Eigennaamlijst 'KorG = StrComp(key, lijstwoord, vbBinaryCompare) '[hierbij zou bijv. "Ĉinio" achter "Zaandam" komen te staan] GoTo 77258 End If matchBinary = False If Not Nulvector Then 'Bij kritische letters (c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ ): Speciale voorbehandeling > en < vergelijking. LenWoord = Len(lijstwoord) For iKritChar = 1 To nKritChar 'Vergelijking tussen Zoekwoord en lijstwoord: iChar = KritCharPos(1, iKritChar) If iChar > LenWoord Then Exit For If AscW(Mid(lijstwoord, iChar, 1)) = KritCharPos(2, iKritChar) Then 'Eerste letterpositie (vanaf links) in beide woorden ontdekt met Tegengesteld Kritische letters ( c - ĉ , g - ĝ , ....); 'Check of ook linkerwoorddelen daaraan voorafgaand gelijk zijn: If Left(key, iChar - 1) = Left(lijstwoord, iChar - 1) Then matchBinary = True: Exit For End If Next iKritChar '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) End If 'Mix van vbText- en vbBinary-compare is nodig ivm ESP-DICT-SORTERING van TaalwoordLijst If Not matchBinary Then 'N.B. Er mogen GEEN HOOFDLETTERS staan in zoekwoord of TaalWoordLijst! KorG = StrComp(key, lijstwoord, vbTextCompare) 'KorG' = (lees:) "Kleiner Of Gelijk", als volgt: KorG=-1 betekent Kleiner; KorG=1 betekent Groter; KorG=0 betekent Gelijk. Else 'If matchBinary Then 'MsgBox "Tegengesteld Kritische Teken(s) op zelfde letterpositie(s), bij I = " & I KorG = StrComp(key, lijstwoord, vbBinaryCompare) 'ivm Tegengesteld Kritische Teken(s) op zelfde letterpositie(s) End If 77258: 'If key < lijstwoord Then 'key < lijstwoord (zoek verder in onderhelft) If KorG = -1 Then ':MsgBox "<" If NowInserting Then GoTo 77151 high = middle - 1 GoTo 77101 'ElseIf key > lijstwoord Then 'key > lijstwoord (zoek verder in bovenhelft) ElseIf KorG = 1 Then ':MsgBox ">" If NowInserting Then GoTo 77152 low = middle + 1 If MetEigennaamBezig Then If low > IendEigennaam Then low = IendEigennaam Else If low > Iend Then low = Iend End If GoTo 77101 Else 'If KorG = 0 Then 'key = lijstwoord ("toevallige voortijdige" match!) 'If NowInserting Then MsgBox "FOUT, bij NowInserting" If NowInserting And StrComp(key, lijstwoord, vbTextCompare) <> 0 Then MsgBox "FOUT, bij NowInserting" '[*14-12-05: bij alleen hoofdletterverschil, bijv. tussen "EUROP-UNIO" en "Europ-Unio", is eigenlijk geen FOUT-melding nodig] low = middle MatchPos = middle 'MsgBox "Match! TaalWoord- of Eigennaam- Lijst-positie = " & MatchPos GoTo 77700 '(binair zoekproces beeindigd) End If Else high = low '[*30-11-05, 'automatische correctie, ivm Inserties geheel aan BEGIN van TaalWoord- of Eigennaam-Lijst] GoTo 77101 '(binair zoekproces nog niet beeindigd) End If 77700: 'Uitgangen bij Match: 'MsgBox "tekstwoord '" & TekstWoord & "' stond al in TaalWoord- of Eigennaam-Lijst" VortSpecMarko = .worksheets(Wsh).Cells(MatchPos, 4) ' ... dus benut het reeds daar opgeslagen VortSpecMarko If MetEigennaamBezig Then GoTo 253 'TekstWoord matcht met een reeds in de tekst-EigennaamLijst aanwezige Eigennaam GoTo 278 'TekstWoord matcht met een reeds in de TaalWoordLijst aanwezig woord] End With 'Uitgang bij GEEN Match: Goto 700 [zie onder label 70255] '++++++++++++++++++++++++++++++++++++++++++einde QUASI SUBROUTINE++++++++++++++++++++++++++++++++++++++++ 9999: '[25-11-06] CalledByTekstAnal = False '[10-3-2008] End Sub Sub TekstVortKontrol(TeTestenWoord As String, VortSpecoKodo As String, VortSynmark As Integer, _ VortGenvoc As Integer, SamenstellingOrHyphenatedCode As String, VortStruct() As String, nVortStruct As Integer, _ Ambigumark As String, iPosOptionalHyphen As Integer) '[2-2-2008]) 'ESPSOF Versio 0.9 12-12-08 TW (Toon Witkam) 'dit macro wordt opgeroepen door TEKSTanal 'toevoeging iPosOptionalHyphen '[12-12-08] als parameter is voor een waarde die door TekstVortKontrol niet verwerkt wordt, ... ' ...maar slechts wordt doorgegeven van KunmetAnaliz naar TEKSTanal [had misschien ook een PRIVATE variable kunnen zijn] 'het macro checkt een woord door en door, met als doel: ' 1. te bepalen of het al dan niet een Esp.-woord is; ' 2. er een WoordSoort aan toe te kennen. 'indien het een hyphenated woord betreft, worden zonodig ook de deelwoorden afzonderlijk gecheckt 'daarbij worden ook (deel-)woorden herkend die NIET in een Esperanto-Dictionary... '...(BRO, PIV, DICT3) staan, maar die wel een Samengesteld Woord (Vortkunmetaĵo) kunnen zijn; 'ook checkt dit macro op het voorkomen van een woord in een EigennaamBoek; 'er mogen dus woorden met HOOFDLETTERS voorkomen Dim VoorkeursSamenstelling(8) As String Dim nGevondenSamenstellingen As Integer 'Dim nSplitsingen(30) As string 'ga uit van max. 30 mogelijke samenstellingen per invoerwoord Dim HeleWoord As String Dim LenWoord As Integer Dim Stam As String '[23-10-08] Dim StamGesplitst As String '[23-10-08] Dim woord As String Dim nHeleWoordinBRO As Integer Dim nHeleWoordinPIV As Integer Dim nHeleWoordinDICT3 As Integer Dim nCerteFremdlinga As Integer Dim EvtFunctieWoordEnKode As String Dim nFouteUitgangMeestRechtseDeelWoord As Integer Dim k1 As Integer Dim k2 As Integer Dim k3 As Integer Dim k4 As Integer Dim k5 As Integer Dim n1 As Integer Dim n2 As Integer Dim n3 As Integer Dim N4 As Integer Dim n5 As Integer Dim MatchStadiumUitgangVariatie As Integer Dim nSamengesteldEspWoord As Integer Dim jFunctieWoord As Integer Dim j1 As Integer Dim jEnd As Integer Dim nFunctiewoord As Integer Dim Accusatief As Boolean Dim Meervoud As Boolean Dim Vervoegd As Boolean Dim Volitivo As Boolean Dim OnbekendFunctiewoord As Boolean Dim Hyphens11010 As Boolean Dim iDeelWoord As Integer Dim nDeelWoord As Integer Dim DeelWoord(10) As String Dim DeelWoordBegin(10) As Integer Dim iHyphen As Integer Dim iNextHyphen As Integer Dim HyphenWoordScore As String Dim WoordDeel As String Dim LenDeel As Integer Dim k As Integer Dim DivScoreTekens As String Dim VoorkeursSamenstDivDeelw As String Dim AantalGevSamenstDivDeelw As String Dim MeestRechtseDeelWoord As Boolean Dim oToegevoegd As Boolean Dim nHeleWoordinExceptionsOo As Integer Dim nHeleWoordinExceptionsAo As Integer Dim nHeleWoordinExceptionsEo As Integer Dim HyphenInInvoerTekstwoord As Boolean Dim TekstwoordNuZonderHyphen As Boolean Dim HeleWoordMetHyphens As String Dim InstellingsOptie1 As Boolean Dim InstellingsOptie2 As Boolean Dim InstellingsOptie3 As Boolean Dim FinajhoPlusPostfinajho As String Dim Laatste2Letters As String Dim ENuitgang As Boolean Dim struct As String Dim synmark As Integer Dim genvoc As Integer Dim asimilmark As Integer Dim propnomkat As Integer Dim i As Integer Dim TaalBoekCheckedFirst As Boolean Dim WoordinDICT3 As Boolean '[8-6-08] Dim NurAfAuMem As String '[15-8-08] 'Dim dankal8217 As Boolean '[6-8-10] TaalBoekCheckedFirst = False WoordinDICT3 = False Ambigumark = "" BROkunmetDeel = False '[27-8-08] NurAfAuMem = "" '[15-8-08] 'dankal8217 = False '[6-10-08] For i = 1 To 4 'max. 4 cellen voor uitgangsparameter VortStruct VortStruct(i) = "" 'default waarden '[30-10-06] Next i VortSynmark = 0 VortGenvoc = 0 SamenstellingOrHyphenatedCode = "" 'Instellingen (zie documentatie-blok in onderdeel 'Hyphenated' ): InstellingsOptie1 = True InstellingsOptie2 = False '----------------------------------Controle of een tekstwoord een (goed) Esp. woord is : ------------------------------ HeleWoord = TeTestenWoord LenWoord = Len(HeleWoord) VortSpecoKodo = "" 'If Not (HeleWoord = "a.K." Or HeleWoord = "p.K.") Then '[uitzonderingen waarbij een VolgHoofdletter van belang is; 7-1-2008] 'HeleWoord = BeginHoofdletterWeg(HeleWoord) '[15-1-08:] hoofdletter behouden ivm EBON 'HeleWoord = VolgHoofdlettersWeg(HeleWoord) '[22-1-08:] volghoofdletters behouden ivm EBON (denk aan ACRONYMEN) 'End If 'Hou rekening met Hyphenated woorden: GoTo 10000 'onder label 10000 zit - als quasi-subroutine - onderin dit macro een groot codeblok voor ... '... inspectie op en verwerking van Hyphenated woorden '----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- 'Verwerking van woorden ZONDER hyphen (of woorden-met-hyphen alleen testen of ze IN HUN GEHEEL met dictionary matchen): 1: 'Hou rekening met het checken op EigennaamBoek: '[15-1-08: invoering EBON] '[CerteFremdlingva' vindt overigens pas plaats ACHTER het raadplegen van de FunctieWoordlijst '*16-11-06] If Not Hoofdletter(Left(HeleWoord, 1)) Then GoTo 2 '[15-1-08] If LenWoord <= 2 And Not TaalBoekCheckedFirst Then 'woorden van max. 2 letters: '[1-2-2008] TaalBoekCheckedFirst = True GoTo 2 Else 'Hoofdletterwoorden van 3 of meer letters: EERST IN EIGENNAAM-BOEK zoeken: 'Bij Hoofdletterwoorden van 3 of meer letters is er de kans dat, ook al zijn het eigenlijk Eigennamen, ze als Taalwoorden (bijv. "admira", "lea", "leon", "pia", "timo", ...) '... of als (formeel correcte maar zinloze) Samenstellingen gedetecteerd worden (bijv. "zap-at-er-o") bij het checken op een TaalwoordenBoek (onder labels 50 resp. 100 hieronder); 'Om dat te vermijden worden deze woorden EERST gecheckt tegen een Eigennamen- en Acronymen-Boek... '...en DAARNA pas (als ze daar niet in staan) tegen een TaalwoordenBoek: 'Opzoeken Hoofdletterwoord in EigennaamBoek & Acronymenboek: '[29-1-08]: 'Eerst de ongewijzigde vorm opzoeken in EigennaamBoek (tevens grootste kans op succes): If MatchEspWordToDict(HeleWoord, "EigennaamBoek", struct, asimilmark, propnomkat, Ambigumark) Then 'Eigennaam staat in ongewijzigde vorm in EigennamenBoek: 'de Eigennaam is ofwel een of Ne-Asimilita (bijv. "Einstein", "Bush", "Leon", "Toon", "Mbojn") ofwel een Asimilita in Hoofdvorm (bijv. "Parizo", "Bermudoj", "Johano") 'let op: bij Asimilitaj eigennamen gelden de vormen op -o en -oj als Hoofdvorm; dus bijv. "Parizon", "Bermudojn", "Johanon" zijn geen Hoofdvormen, maar... '...wel kan er een NE-Asimilita eigennaam als bijv. "Leon" of "Mbojn" in het EigennaamBoek staan) GoTo 25 Else 'Eigennaam staat (althans in ongewijzigde vorm) NIET in EigennaamBoek: If Right(HeleWoord, 2) = "on" Then Accusatief = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 1) ' -on wordt -o ElseIf LenWoord > 2 Then If Right(HeleWoord, 3) = "ojn" Then Accusatief = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 1) ' -ojn wordt -oj Else GoTo 29 'NIET in EigennaamBoek End If Else GoTo 29 'NIET in EigennaamBoek End If 'Nu de gewijzigde vorm (Hoofdvorm op -o) opzoeken in EigennaamBoek: If MatchEspWordToDict(HeleWoord, "EigennaamBoek", struct, asimilmark, propnomkat, Ambigumark) _ And asimilmark = 1 Then GoTo 25 'Eigennaam (Asimilita) staat in Hoofdvorm WEL in EigennaamBoek Else If Accusatief Then HeleWoord = HeleWoord & "n" '[4-10-2008, n.a.v. foute verwerking van "Kion", "Tion", "Ĉion", "Ion", "Nenion" ] GoTo 29 'NIET in EigennaamBoek End If End If 25: 'Woord staat in EigennaamBoek: If asimilmark = 1 Then 'Asimilita (Esperantigita) Propra Nomo ("Johano", "Parizo", ...) : If Not Accusatief Then If Right(HeleWoord, 1) <> "j" Then FinajhoPlusPostfinajho = "o": VortSpecoKodo = "EB&N" '(Eigennaam in Nominatief, bijv. "Francio") If struct = "" Then struct = Left(HeleWoord, LenWoord - 1) & ChrW(MorDis) '[voor het geval de 'struct' zou ontbreken in het EigennamenBoek] Else 'If Right(HeleWoord, 1) = "j" Then FinajhoPlusPostfinajho = "oj": VortSpecoKodo = "EB&Nj" '(Eigennaam in MEERVOUD, bijv. "Bermudoj") If struct = "" Then struct = Left(HeleWoord, LenWoord - 2) & ChrW(MorDis) '[voor het geval de 'struct' zou ontbreken in het EigennamenBoek] End If Else 'If Accusatief Then If Right(HeleWoord, 1) <> "j" Then FinajhoPlusPostfinajho = "on": VortSpecoKodo = "EB&N4" '(Eigennaam in de ACCUSATIEF, bijv. "Berlinon") If struct = "" Then struct = Left(HeleWoord, LenWoord - 2) & ChrW(MorDis) '[voor het geval de 'struct' zou ontbreken in het EigennamenBoek] Else 'If Right(HeleWoord, 1) = "j" Then FinajhoPlusPostfinajho = "ojn": VortSpecoKodo = "EB&N4j" '(Eigennaam in de MEERVOUD ACCUSATIEF, bijv. "Bermudojn") If struct = "" Then struct = Left(HeleWoord, LenWoord - 3) & ChrW(MorDis) '[voor het geval de 'struct' zou ontbreken in het EigennamenBoek] End If End If VortStruct(1) = struct & FinajhoPlusPostfinajho ' = STRUCT + FINAĴO + POSTFINAĴO '(STRUCT is rechtstreeks afkomstig van MatchEspToDict) Else 'bij Ne-Asimilita Propra Nomo ("Einstein", "Bush", "Leon", ...) : VortSpecoKodo = "EB" '(aan Ne-Asimilataj kan niet worden gezien in welke syntaktische rol zij fungeren) 'indien ambigumark = "EBO..." (bijv. "EBON", "EBON4", "EBOA", ...) dan kan het woord ipv Eigennaam OOK Taalwoord zijn 'VortStruct(1) = HeleWoord '(bij Ne-Asimilitaj wordt ervan uitgegaan dat 'struct' leeg is) '[Vortstruct(1) doorgeven aan EspTekstAnalizilo is dan niet nodig] End If VortSynmark = asimilmark VortGenvoc = propnomkat SamenstellingOrHyphenatedCode = "" nVortStruct = 1 GoTo 999 'Woord komt als Eigennaam voor in EigennaamBoek '[15-1-08] 29: 'Woord staat NIET in EigennaamBoek: VortSpecoKodo = "" 'deze en onderstaande stmts wellicht overbodig, want hierna GoTo 2 VortSynmark = 0 VortGenvoc = 0 SamenstellingOrHyphenatedCode = "" 'nVortStruct = 1 '[22-10-08 22.00h: verwijderd, en in plaats daarvan "nVortStruct = 0" onder label 2 ] TaalBoekCheckedFirst = False GoTo 2 'Woord komt NIET als Eigennaam voor in EigennaamBoek,... '... check nu het woord tegen TaalwoordenBoek '[15-1-08] End If '[15-1-08] 2: 'Check het woord tegen TaalwoordenBoek(en): '[15-1-08: nadruk op "Taal-", i.t.t. Eigennamen-Boek] nVortStruct = 0 '[22-10-08 22.00h] 'Scan-fout behandeling van frequente taalwoorden [12-4-2008]: 'niet herkenning van letter l (kleine letter, zoals in lidwoord "la"): If ScanProblem1l Then If HeleWoord = "1a" And PreviousTekstWoord <> "la" Then HeleWoord = "la" 'bij voorafgaand "la" blijft "1a" (in betekenis "unua") behouden End If 'niet herkenning van Ĉ (hoofdletter C met supersigno): If ScanProblemCC Then If HeleWoord = "Ciu" Then HeleWoord = ChrW(264) & "iu" If HeleWoord = "Ciun" Then HeleWoord = ChrW(264) & "iun" If HeleWoord = "Ciuj" Then HeleWoord = ChrW(264) & "iuj" If HeleWoord = "Ciujn" Then HeleWoord = ChrW(264) & "iujn" End If 'niet herkenning van Ŝ (hoofdletter S met supersigno): If ScanProblemSS Then If HeleWoord = "Sajne" Then HeleWoord = ChrW(348) & "ajne" If HeleWoord = "Sajnas" Then HeleWoord = ChrW(348) & "ajnas" If HeleWoord = "Sajnis" Then HeleWoord = ChrW(348) & "ajnis" End If HeleWoord = BeginHoofdletterWeg(HeleWoord) 'CONVERTEER (alleen tijdelijk) Beginhoofdletter: 'Check of het woord een Esp. FunctieWoord is: If LenWoord = 8 Then 'Uitzondering voor "dank' al" (woord met spatie en evt. unicode 8217 apostrof) [6-10-08]: If Left(HeleWoord, 4) = "dank" Then If HeleWoord = "dank' al" Then struct = "dank' al": VortSpecoKodo = "p": GoTo 90 If HeleWoord = "dank" & ChrW(8217) & " al" Then struct = "dank" & ChrW(8217) & " al": VortSpecoKodo = "p": GoTo 90 End If End If If LenWoord = 7 Then 'Uitzondering voor "dank'al" (woord met evt. unicode 8217 apostrof) [6-10-08]: If Left(HeleWoord, 4) = "dank" Then If HeleWoord = "dank'al" Then struct = "dank'al": VortSpecoKodo = "p": GoTo 90 If HeleWoord = "dank" & ChrW(8217) & "al" Then struct = "dank" & ChrW(8217) & "al": VortSpecoKodo = "p": GoTo 90 End If End If If LenWoord = 4 Then 'Uitzonderingen waarbij een VolgHoofdletter van belang is [7-1-08]: If InStr(2, HeleWoord, ".K.") = 2 Then If HeleWoord = "a.K." Then struct = "a.K.": VortSpecoKodo = "m": GoTo 90 If HeleWoord = "p.K." Then struct = "p.K.": VortSpecoKodo = "m": GoTo 90 'VortSpecoKodo "m" = mallongigo (alle Esp. Mallongigoj worden hier gerekend tot de Esp. FunctieWoorden) End If End If 'Check op GEWONE FUNCTIEWOORDEN: EvtFunctieWoordEnKode = HeleWoord If MatchEspWordToDict(EvtFunctieWoordEnKode, "FunctieWoordenLijst", struct, synmark, genvoc, Ambigumark) Then 'MsgBox "Functiewoord gevonden: " & HeleWoord 'MsgBox "Bijbehorende kode: " & EvtFunctieWoordEnKode If EvtFunctieWoordEnKode = ChrW(165) And Not StreketoEnNombrGhis100 Then GoTo 40 '[doe alsof MatchEspWordToDict = false] If Not ArkaikCiAkceptu Then '[12-5-08] If Left(struct, 2) = "ci" Then GoTo 9 'arkaika pronomo ' ci ' wordt als fout woord beschouwd (tenzij ArkaikCiAkceptu = true) End If VortSpecoKodo = EvtFunctieWoordEnKode GoTo 90 'woord is Esp. FunctieWoord End If 40: 'Woorden die zeker geen Esp.woord zijn (anderstalige woorden, onbekende eigennamen) uitfilteren: '[###15-1-08: "onbekende"] If CerteFremdlingva(HeleWoord) Then '.Cells(i, iColumn).Font.ColorIndex = 3 'ROOD maken van NIET-Esp.- woord '.Cells(i, iColumnErvoor).Value = "' , " 'bij wijze van niet-Esp.-teken een KOMMA zetten in de kolom ervoor '[** ipv E, 21-6-05 ] GoTo 9 End If 50: 'Check of het woord een Esp. InhoudsWoord is (let op: de hieronder meermaals aan te roepen Function 'MatchEnkelEspWordToDictionary' ... ' ... vereist dat de te testen inhoudswoorden in hun grammaticale Hoofdvorm worden aangeboden): 'Uitgangen van inhoudswoorden terugbrengen naar Hoofdvorm (-o, -a, -e, -i), door weghalen PostFinaĵoj: Laatste2Letters = Right(HeleWoord, 2) '[30-10-06] If Laatste2Letters = "en" Then ' -en blijft -en ENuitgang = True '[*12-2-2007] Else 'If Right(HeleWoord, 2) <> "en" Then ENuitgang = False '[*12-2-2007] If Right(HeleWoord, 1) = "n" Then Accusatief = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 1) ' -on wordt -o, -an wordt -a, -ojn wordt -oj, -ajn wordt -aj If Right(HeleWoord, 1) = "j" Then Meervoud = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 1) ' -oj wordt -o, -aj wordt -a If Right(HeleWoord, 1) = "s" Then Vervoegd = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 2) & "i" ' -as wordt -i, -is wordt -i, -os wordt -i, -us wordt -i If Right(HeleWoord, 1) = "u" Then Volitivo = True: HeleWoord = Left(HeleWoord, Len(HeleWoord) - 1) & "i" ' -u wordt -i End If '[30-10-06:] FinajhoPlusPostfinajho = Right(HeleWoord, 1) ' = "o", "a", "i", "e", of "n" ingeval van "en" If FinajhoPlusPostfinajho = "n" Then FinajhoPlusPostfinajho = "en" If Accusatief And Not Meervoud Then FinajhoPlusPostfinajho = FinajhoPlusPostfinajho & "n" If Meervoud And Not Accusatief Then FinajhoPlusPostfinajho = FinajhoPlusPostfinajho & "j" If Accusatief And Meervoud Then FinajhoPlusPostfinajho = FinajhoPlusPostfinajho & "jn" If Vervoegd Then FinajhoPlusPostfinajho = Laatste2Letters If Volitivo Then FinajhoPlusPostfinajho = "u" '[30-10-06.] 'Controle: If Not (Right(HeleWoord, 1) = "o" Or Right(HeleWoord, 1) = "a" Or Right(HeleWoord, 1) = "e" Or Right(HeleWoord, 2) = "en" Or Right(HeleWoord, 1) = "i") Then 'MsgBox "woord terugbrengen naar Hoofdvorm NIET gelukt" & vbCr & _ "(mogelijk onbekend functiewoord!)" OnbekendFunctiewoord = True '.Cells(i, iColumn).Font.ColorIndex = 3 'ROOD maken van NIET-Esp.- woord '.Cells(i, iColumnErvoor).Value = "' !? " 'niet-Esp.-teken zetten in de kolom ervoor [ n' , ter onderscheiding van n ] GoTo 9 'GEEN goed Esp. woord (of mogelijk een onbekend of niet geregistreerd functiewoord) End If 'Eerst checken of het woord als geheel bestaat in een van de Dictionaries [Reichling-stelling!]:: MatchStadiumUitgangVariatie = 0 If MatchEspWordToDict(HeleWoord, "BRO", struct, synmark, genvoc, NurAfAuMem) And NurAfAuMem = "" Then GoTo 91 'een woord op "en" wordt zowel in BRO, PIV als DICT3 automatisch gematcht op een aparte "en"-kolom [26-8-08] If Not BROonly Then '[22-9-08] If MatchEspWordToDict(HeleWoord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(HeleWoord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 End If 'VARIEER Hoofd-Uitgang indien nog geen dictionary-match heeft plaatsgehad '(bijv. 'diskrete' staat niet, maar 'diskreta' wel in het Dictionary): '[22-9-08:] Bij uitgangsvariatie is heroproep van BRO zinloos, omdat BRO geen woorden maar radikoj bevat, en omdat de "S"-parameter bij BRO evenmin tot uitgangsvariatie leidt ! If Not BROonly Then '[22-9-08] LenWoord = Len(HeleWoord) '(door terugbrengen woorduitgang naar Hoofdvorm kan LenWoord inmiddels veranderd zijn) [27-11-05] If Right(HeleWoord, 1) = "e" Then MatchStadiumUitgangVariatie = 1 'varieer -e -> -a, -i k1 = k1 + 1 woord = Left(HeleWoord, LenWoord - 1) & "S" 'varieer -e -> -a, -i dmv S-kolom (in MatchEspWordToDict) [& "a" vervangen door & "S", op 29-1-07] 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 91 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 'Speciale toevoeging voor woorden op -cie (aŭkcie , mutacie ...): 'If LenWoord >= 5 And Right(HeleWoord, 3) = "cie" Then [*dit uitgebreid tot elk woord met e-uitgang, op 29-1-07] MatchStadiumUitgangVariatie = 5 'varieer -e -> -o k5 = k5 + 1 woord = Left(HeleWoord, LenWoord - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 91 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 'End If ElseIf Right(HeleWoord, 1) = "a" Then MatchStadiumUitgangVariatie = 2 'varieer -a -> -o k2 = k2 + 1 woord = Left(HeleWoord, LenWoord - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 91 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 ElseIf Right(HeleWoord, 1) = "o" Then MatchStadiumUitgangVariatie = 3 'varieer -o -> -i k3 = k3 + 1 woord = Left(HeleWoord, LenWoord - 1) & "i" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 91 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 ElseIf Right(HeleWoord, 1) = "i" Then MatchStadiumUitgangVariatie = 4 'varieer -i -> -o k4 = k4 + 1 woord = Left(HeleWoord, LenWoord - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 91 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 92 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 93 End If End If GoTo 100 'Na matching met Dictionary van het HeleWoord (al dan niet na uitgangsverandering): 90: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nFunctiewoord = nFunctiewoord + 1 GoTo 95 91: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinBRO = nHeleWoordinBRO + 1 GoTo 95 92: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinPIV = nHeleWoordinPIV + 1 GoTo 95 93: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinDICT3 = nHeleWoordinDICT3 + 1 '<==== met al die tellers wordt NIKS meer gedaan ! ####### [8-6-08] WoordinDICT3 = True '[8-6-08] GoTo 95 95: '.Cells(i, iColumn).Font.ColorIndex = 5 'DONKERBLAUW' '.Cells(i, iColumnErvoor).Value = "' + " 'plusje zetten in de kolom ervoor (voor gemakkelijk uitsorteren) 'Telling van succesvolle uitgangsveranderingen: 'If MatchStadiumUitgangVariatie = 1 Then n1 = n1 + 1 'If MatchStadiumUitgangVariatie = 2 Then n2 = n2 + 1 'If MatchStadiumUitgangVariatie = 3 Then n3 = n3 + 1 'If MatchStadiumUitgangVariatie = 4 Then n4 = n4 + 1 'If MatchStadiumUitgangVariatie = 5 Then n5 = n5 + 1 'Hou rekening met zowel de terug te melden (uit Dict afkomstige Morfeem-) Structuur van de stam als met de Uitgang van het tekstwoord: '[30-10-06] If Not ENuitgang Then '[*12-02-07] VortStruct(1) = struct & FinajhoPlusPostfinajho ' = STRUCT + FINAĴO + POSTFINAĴO '(STRUCT is rechtstreeks afkomstig van MatchEspToDict) '['30-10-06] Else 'If ENuitgang: VortStruct(1) = Left(struct, Len(struct) - 1) ' = STRUCT '(STRUCT is hier zowel INCLUSIEF uitgang -en als INCLUSIEF MorDis-teken daarna) '[*12-02-2007] End If If WoordinDICT3 Then '[8-6-08] If Not ENuitgang Then '[*12-02-07] If InStr(2, Left(struct, Len(struct) - 1), ChrW(MorDis)) > 0 Then SamenstellingOrHyphenatedCode = "s0" 'MorDis (afgezien van MorDis vlak voor FinajhoPlusPostfinajho) wijst op samenstelling 's0 ("s nul") geeft aan het oproepende programma (TEKSTanal) door dat dit woord als kunmetaĵo in Dict3 stond (in PIV zou het helemaal geen aanduiding "s" gekregen hebben); 'in Dict3 kunnen ook neologismen (novradikoj) voorkomen, vandaar dat gecheckt wordt of het Dict3-woord echt een samenstelling is; Else 'If ENuitgang: If InStr(2, Left(struct, Len(struct) - 4), ChrW(MorDis)) > 0 Then SamenstellingOrHyphenatedCode = "s0" 'MorDis (afgezien van MorDis vlak voor -en) wijst op samenstelling 's0 ("s nul") geeft aan het oproepende programma (TEKSTanal) door dat dit woord als kunmetaĵo in Dict3 stond (in PIV zou het helemaal geen aanduiding "s" gekregen hebben); 'in Dict3 kunnen ook woorden op -en voorkomen die geen samenstelling zijn '[9-6-08: ##### 55 -en woorden in kolom W van PIV moeten nog naar Dict3 verplaatst worden!] End If End If nVortStruct = 1 GoTo 10 'goedgekeurd Esp. woord (FunctieWoord of Inhoudswoord) 'Bij NIET-matchen met Dictionary van het HeleWoord (ook bij Niet-matchen na uitgangsverandering), 'ga na of het woord misschien een NIET-in-het-woordenboek staande SAMENSTELLING (een Ne-Envortara Kunmetajho) is: 100: '[*6-12-05] uitzonderingen (woorden-met-hyphen die eerst in hun geheel gematcht worden): If HyphenInInvoerTekstwoord Then GoTo 11007 '[*6-12-05] (na matchpoging hele tekstwoord-met-hyphens) If TekstwoordNuZonderHyphen Then GoTo 11008 '[*6-12-05] (na matchpoging hele tekstwoord-zonder-hyphens) ' If KunmetAnaliz(HeleWoord, VoorkeursSamenstelling, nGevondenSamenstellingen, iPosOptionalHyphen) Then '[30-10-06, ipv 'PlurVortKunmetoEkzist' ] '.Cells(i, iColumnVoorkeurKunmet).Value = VoorkeursSamenstelling HyphenWoordScore = "s" 'via de 3e parameter van dit macro wordt nu "s" teruggemeld [zie ook onder label 90909]; If nGevondenSamenstellingen > 4 Then nGevondenSamenstellingen = 4 '...maximaal 4 '[*30-10-06] If nGevondenSamenstellingen = 1 Then SamenstellingOrHyphenatedCode = "s" If nGevondenSamenstellingen = 2 Then SamenstellingOrHyphenatedCode = "s2" If nGevondenSamenstellingen = 3 Then SamenstellingOrHyphenatedCode = "s3" If nGevondenSamenstellingen = 4 Then SamenstellingOrHyphenatedCode = "s4" 'VoorkeursSamenstelling zal via de 1e parameter van TekstVortKontrol worden teruggemeld, waarbij... '[*23-12-2005] 'Samenstellings-Varianten zullen de 4e parameter van TekstVortKontrol worden doorgegeven, en wel... '[*30-10-06] For i = 1 To nGevondenSamenstellingen If Not ENuitgang Then '[*12-02-2007] VortStruct(i) = Left(VoorkeursSamenstelling(i), Len(VoorkeursSamenstelling(i)) - 1) & FinajhoPlusPostfinajho '[*30-10-06] Else VortStruct(i) = VoorkeursSamenstelling(i) '[VoorkeursSamenstelling(i) is hier reeds INCLUSIEF uitgang -en ] '[*12-02-2007] End If Next i nVortStruct = nGevondenSamenstellingen '.Cells(i, iColumnAantalKunmet).Value = nGevondenSamenstellingen nSamengesteldEspWoord = nSamengesteldEspWoord + 1 ' '***[24-10-08:] ***bij onderstaand blok nog toe te voegen: soortgelijke speciale behandeling bij Genvoc16only (Opcio III) en bij TutaPIV (Opcio II) ' 'Speciale behandeling bij BROonly (ESPSOF-Opcio IV) : ------------------------------------- [30-9-08], [23-10-08]------------------------------------- If BROonly Then 'VortStruct(1) is VortStructBRO (de Kunmetaĵ-bestanddelen zijn BRO-radikoj !) 'Om door zinloze Kunmetaĵo-analyses goedkeuring van wat eigenlijk PIV-woorden zijn te vermijden (bijv. bij "rekt-or-o"), ... 'wordt gecheckt of de Stam (hele Samenstelling, maar ZONDER finajho en postfinajho) die van een PIV- of Dict3-woord is: 735: BROonly = False '(anders blijft de toegang tot PIV en Dict3 geblokkeerd) Stam = Left(HeleWoord, Len(HeleWoord) - 1) '(Helewoord is hier reeds ZONDER postfinajho) '[23-10-08] If MatchEspWordToDict(Stam & "o", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 75 If MatchEspWordToDict(Stam & "a", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 75 '***deze regel kan weg zodra verzekerd is dat elk -a woord ook in S-kolom staat ! [24-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 75 If MatchEspWordToDict(Stam & "o", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 75 If MatchEspWordToDict(Stam & "a", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 75 '***deze regel kan weg zodra verzekerd is dat elk -a woord ook in S-kolom staat ! [24-10-08] If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 75 StamGesplitst = Left(VortStruct(1), InStr(3, VortStruct(1), ChrW(MorDis) & FinajhoPlusPostfinajho) - 1) 'stam in morfemen gesplitst : '[23-10-08] 740: 'If Right(StamGesplitst, 3) = ChrW(MorDis) & "at" Or Right(StamGesplitst, 3) = ChrW(MorDis) & "it" Or Right(StamGesplitst, 3) = ChrW(MorDis) & "ot" Then If Right(StamGesplitst, 3) = ChrW(MorDis) & "at" Then FinajhoPlusPostfinajho = "at" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 741 If Right(StamGesplitst, 3) = ChrW(MorDis) & "it" Then FinajhoPlusPostfinajho = "it" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 741 If Right(StamGesplitst, 3) = ChrW(MorDis) & "ot" Then FinajhoPlusPostfinajho = "ot" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 741 GoTo 745 741: Stam = Left(Stam, Len(Stam) - 2) 'stam zonder suffix "at", "it", "ot" : '[23-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 75 If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 75 GoTo 749 745: 'ElseIf Right(StamGesplitst, 4) = ChrW(MorDis) & "ant" Or Right(StamGesplitst, 4) = ChrW(MorDis) & "int" Or Right(StamGesplitst, 4) = ChrW(MorDis) & "ont" Then If Right(StamGesplitst, 4) = ChrW(MorDis) & "ant" Then FinajhoPlusPostfinajho = "ant" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 746 If Right(StamGesplitst, 4) = ChrW(MorDis) & "int" Then FinajhoPlusPostfinajho = "int" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 746 If Right(StamGesplitst, 4) = ChrW(MorDis) & "ont" Then FinajhoPlusPostfinajho = "ont" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 746 GoTo 749 746: Stam = Left(Stam, Len(Stam) - 3) 'stam zonder suffix "ant", "int", "ont" : '[23-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 75 If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 75 749: 'End If BROonly = True GoTo 10 'goedgekeurd (in PIV of Dict3 staat GEEN woord met dezelfde stam, bijv. "urbohundo", "urbohunda", ...) 75: BROonly = True 'If struct & FinajhoPlusPostfinajho = VortStruct(1) Then GoTo 10 'goedgekeurd (in PIV of Dict3 staat dezelfde Struct als Envortara Kunmetaĵo, bijv. "urb-o-dom-o") For i = 1 To nVortStruct If struct & FinajhoPlusPostfinajho = VortStruct(i) Then GoTo 77 'goedgekeurd (in PIV of Dict3 staat dezelfde Struct als Envortara Kunmetaĵo, bijv. "urb-o-dom-o") '[22-10-08] Next i 'MsgBox ("woord " & struct & FinajhoPlusPostfinajho & " is eigenlijk een PIV- of Dict3-woord," & vbCr & "maar tegelijk een onzinnige combinatie van BRO-morfemen") '[22-10-08] GoTo 9 'afgekeurd (in PIV of Dict3 staat wel hetzelfde woord, maar met een andere Struct, bijv. "rektor-o" vs. "rekt-or-o", "arogant-ec-o" vs. "ar-o-gant-ec-o" ) 77: If i = 1 Then GoTo 10 'goedgekeurd 'Indien niet (BRO-)VortStruct(1) maar VortStruct(2) [of (3), (4) ] matcht met de "struct" van PIV of Dict3, ... VortStruct(1) = VortStruct(i) '...maak dan van de matchende (BRO-)Vortstruct Vortstruct(1) ... nVortStruct = 1 '...en gooi de overige VortStruct's weg; op deze manier kan het extra nut van Dict3 als opslag van woorden louter terwille van hun morfeemstructuur, oftewel ... GoTo 10 'goedgekeurd '....ter vermijding van onzinnige splitsingsvarianten, ook bij BROonly voor kunmetaĵoj gehandhaafd blijven [30-9-08] 'einde Speciale behandeling BROonly ---------------------------------- [30-9-08], [23-10-08]-------------------------------------- ' 'Speciale behandeling bij GenVoc16only (ESPSOF-Opcio III) : ------------------------------------- [27-10-08]------------------------------------- ElseIf GenVoc16only Then 'VortStruct(1) is VortStructGenVoc16 (de Kunmetaĵ-bestanddelen hebben in PIV GenVoc=16 ) 'Om door zinloze Kunmetaĵo-analyses goedkeuring van wat eigenlijk PIV-woorden-zonder-GenVoc16 zijn te vermijden (bijv. bij "karbon-ad-o" ipv "karbonad-o" ) 'wordt gecheckt of de Stam (hele Samenstelling, maar ZONDER finajho en postfinajho) die van een PIV-zonder-GenVoc16- of Dict3-woord is: 755: GenVoc16only = False '(anders blijft de toegang tot PIV-zonder-GenVoc16 en Dict3 geblokkeerd) Stam = Left(HeleWoord, Len(HeleWoord) - 1) '(Helewoord is hier reeds ZONDER postfinajho) '[23-10-08] If MatchEspWordToDict(Stam & "o", "PIV", struct, synmark, genvoc, Ambigumark) And genvoc <> 16 Then GoTo 775 If MatchEspWordToDict(Stam & "a", "PIV", struct, synmark, genvoc, Ambigumark) And genvoc <> 16 Then GoTo 775 '***deze regel kan weg zodra verzekerd is dat elk -a woord ook in S-kolom staat ! [24-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) And genvoc <> 16 Then GoTo 775 If MatchEspWordToDict(Stam & "o", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 775 If MatchEspWordToDict(Stam & "a", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 775 '***deze regel kan weg zodra verzekerd is dat elk -a woord ook in S-kolom staat ! [24-10-08] If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 775 '-----[24-1-09]---- If InStr(3, VortStruct(1), ChrW(MorDis) & FinajhoPlusPostfinajho) > 0 Then '[24-1-09] bij "De morgen" StamGesplitst = Left(VortStruct(1), InStr(3, VortStruct(1), ChrW(MorDis) & FinajhoPlusPostfinajho) - 1) 'stam in morfemen gesplitst : '[23-10-08] Else GoTo 9 'afgekeurd (voorlopige oplossing) '[24-1-09, n.a.v. fout bij tekst "De morgen" ] End If '----- 'StamGesplitst = Left(VortStruct(1), InStr(3, VortStruct(1), ChrW(MorDis) & FinajhoPlusPostfinajho) - 1) 'stam in morfemen gesplitst : '[23-10-08] 760: 'If Right(StamGesplitst, 3) = ChrW(MorDis) & "at" Or Right(StamGesplitst, 3) = ChrW(MorDis) & "it" Or Right(StamGesplitst, 3) = ChrW(MorDis) & "ot" Then If Right(StamGesplitst, 3) = ChrW(MorDis) & "at" Then FinajhoPlusPostfinajho = "at" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 761 If Right(StamGesplitst, 3) = ChrW(MorDis) & "it" Then FinajhoPlusPostfinajho = "it" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 761 If Right(StamGesplitst, 3) = ChrW(MorDis) & "ot" Then FinajhoPlusPostfinajho = "ot" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 761 GoTo 765 761: Stam = Left(Stam, Len(Stam) - 2) 'stam zonder suffix "at", "it", "ot" : '[23-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) And genvoc <> 16 Then GoTo 775 If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 775 GoTo 769 765: 'ElseIf Right(StamGesplitst, 4) = ChrW(MorDis) & "ant" Or Right(StamGesplitst, 4) = ChrW(MorDis) & "int" Or Right(StamGesplitst, 4) = ChrW(MorDis) & "ont" Then If Right(StamGesplitst, 4) = ChrW(MorDis) & "ant" Then FinajhoPlusPostfinajho = "ant" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 766 If Right(StamGesplitst, 4) = ChrW(MorDis) & "int" Then FinajhoPlusPostfinajho = "int" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 766 If Right(StamGesplitst, 4) = ChrW(MorDis) & "ont" Then FinajhoPlusPostfinajho = "ont" & ChrW(MorDis) & FinajhoPlusPostfinajho: GoTo 766 GoTo 769 766: Stam = Left(Stam, Len(Stam) - 3) 'stam zonder suffix "ant", "int", "ont" : '[23-10-08] If MatchEspWordToDict(Stam & "S", "PIV", struct, synmark, genvoc, Ambigumark) And genvoc <> 16 Then GoTo 775 If MatchEspWordToDict(Stam & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 775 769: 'End If GenVoc16only = True GoTo 10 'goedgekeurd (in PIV of Dict3 staat GEEN woord met dezelfde stam, bijv. "urbohundo", "urbohunda", ...) 775: GenVoc16only = True 'If struct & FinajhoPlusPostfinajho = VortStruct(1) Then GoTo 10 'goedgekeurd (in PIV-zonder-GenVoc16 of Dict3 staat dezelfde Struct als Envortara Kunmetaĵo, bijv. "urb-o-dom-o") For i = 1 To nVortStruct If struct & FinajhoPlusPostfinajho = VortStruct(i) Then GoTo 777 'goedgekeurd (in PIV-zonder-GenVoc16 of Dict3 staat dezelfde Struct als Envortara Kunmetaĵo, bijv. "urb-o-dom-o") '[22-10-08] Next i 'MsgBox ("woord " & struct & FinajhoPlusPostfinajho & " is eigenlijk een PIV-zonder-GenVoc16- of Dict3-woord," & vbCr & "maar tegelijk een onzinnige combinatie van BRO-morfemen") '[22-10-08] GoTo 9 'afgekeurd (in PIV-zonder-GenVoc16 of Dict3 staat wel hetzelfde woord, maar met een andere Struct, bijv. "karbonad-o" vs. "karbon-ad--o" ) 777: If i = 1 Then GoTo 10 'goedgekeurd 'Indien niet (GenVoc16-)VortStruct(1) maar VortStruct(2) [of (3), (4) ] matcht met de "struct" van PIV of Dict3, ... VortStruct(1) = VortStruct(i) '...maak dan van de matchende (GenVoc16-)Vortstruct Vortstruct(1) ... nVortStruct = 1 '...en gooi de overige VortStruct's weg; op deze manier kan het extra nut van Dict3 als opslag van woorden louter terwille van hun morfeemstructuur, oftewel ... GoTo 10 'goedgekeurd '....ter vermijding van onzinnige splitsingsvarianten, ook bij GenVoc16only voor kunmetaĵoj gehandhaafd blijven [30-9-08] 'einde Speciale behandeling GenVoc16only ---------------------------------- [30-9-08], [23-10-08]-------------------------------------- End If 'Bij GEEN BROonly en GEEN GenVoc16only: GoTo 10 'goedgekeurde Esp. Samenstelling Else 'If KunmetAnaliz = False: GoTo 9 'GEEN Esp. woord, althans niet binnen het bereik van de betreffende ESPSOF-Opcio (I, II, III of IV) End If 9: 'woord aangetroffen dat GEEN goed Esp. woord is: 'MsgBox "GEEN goed Esp. woord" VortSpecoKodo = "f" 'If OnbekendFunctiewoord Then VortSpecoKodo = "x" [ <== afgeschakeld 9-1-2008; ook een "onbekend Functiewoord" moet rood gemaakt worden! ] If TaalBoekCheckedFirst Then '[###15-1-08] HeleWoord = BeginHoofdletterTerug(HeleWoord) '(hiemee wordt Beginhoofdletter weer teruggezet) GoTo 1 '[###15-1-08] End If GoTo 90909 10: 'Goedgekeurd Esp. woord of Samenstelling: 'MsgBox "'" & HeleWoord & "' is goedgekeurd" If VortSpecoKodo = "" Then '(behalve bij FunctieWoord is er nog GEEN VortSpecoKodo toegewezen) '*If MatchStadiumUitgangVariatie > 0 Then HeleWoord = woord '*was principieel FOUTE stmt!! [* "marsa"-geval, bij Test 24-11-05, 22.00 uur] If Right(HeleWoord, 1) = "o" Then VortSpecoKodo = "N" 'Noun op -o If Accusatief Then VortSpecoKodo = "N4" 'Noun op -on If Meervoud Then VortSpecoKodo = "Nj" 'Noun op -oj If Accusatief And Meervoud Then VortSpecoKodo = "N4j" 'Noun op -ojn ElseIf Right(HeleWoord, 1) = "a" Then VortSpecoKodo = "A" 'Adjective op -a If Accusatief Then VortSpecoKodo = "A4" 'Adjective op -an If Meervoud Then VortSpecoKodo = "Aj" 'Adjective op -aj If Accusatief And Meervoud Then VortSpecoKodo = "A4j" 'Adjective op -ajn ElseIf Right(HeleWoord, 1) = "e" Then VortSpecoKodo = "b" 'bijwoord (adverb) op -e ElseIf Right(HeleWoord, 2) = "en" Then VortSpecoKodo = "b" 'bijwoord (adverb) op -en ElseIf Right(HeleWoord, 1) = "i" Then If Vervoegd Then VortSpecoKodo = "W" 'vervoegd werkwoord op -as, -is, -os, -us ElseIf Volitivo Then VortSpecoKodo = "Wu" 'vervoegd werkwoord op -u Else: VortSpecoKodo = "i" 'infinite Verb End If End If End If 90909: 'De string HyphenWoordScore ( "", "s", "H", of bijv. "H1++" , bij resp. een unhyphenated niet en wel samengesteld... ' woord, een hyphenated woord dat in z'n geheel matchte met een dictionary, en een woord met 1 hyphen waarbij de beide... ' woorddelen afzonderlijk matchten met een dictionary) wordt nu teruggemeld via de derde parameter van het macro: If Hyphens11010 Then HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord SamenstellingOrHyphenatedCode = HyphenWoordScore End If 'Ook nog doorgeven van twee extra uitvoerparameters van MatchEspToDict: '[30-10-06] VortSynmark = synmark VortGenvoc = genvoc 990: 'Einde controle van het hele woord GoTo 999 '--------------------------------------Begin inspectie-op en speciale-verwerking-van 'Hyphenated' woorden----------------------------------------------------------------- 10000: '* in onderstaande code ontbreekt nog: ' - sophisticated Hoofdletter-verwerking in hyphenated (samengestelde) woorden. If Hyphens11010 Then Hyphens11010 = False For iHyphen = 1 To nDeelWoord DeelWoord(iHyphen) = " " Next iHyphen End If iDeelWoord = 1 If LenWoord = 1 Then GoTo 11111 '(indien hele woord is 1-letter-woord) DeelWoordBegin(1) = 1 DeelWoord(1) = HeleWoord '(default value) iHyphen = 0 'Lus (tot label 11111) voor het vaststellen van aantal evt. DeelWoorden, Hyphen- en DeelWoord-posities: 11001: 'eerste evt. hyphen pas vanaf positie 2 mogelijk (bijv: "n-ro"); laatste evt. hyphen op voorlaatste woordpositie; iNextHyphen = InStr(iHyphen + 2, Left(HeleWoord, LenWoord - 1), "-") 'minimale lengte DeelWoord: 1 letter If iNextHyphen = 0 Then GoTo 11111 'geen (verdere) hyphens 'Hyphen aangetroffen: 'MsgBox "Hyphen aangetroffen" '[30-10-06] TYDELIJKE ATTENDERING HyphenWoordScore = "H" '[*7-12-05]------------------Instellings-Opties voor de verwerking van woorden met Hyphens------------------------- If InstellingsOptie1 And Not Hyphens11010 Then 'maak gebruik van hyphenated entries in dictionaries: HyphenInInvoerTekstwoord = True '['Not Hyphens11010' zorgt ervoor dat deze escapade slechts 1 x per tekstwoord doorlopen wordt] GoTo 11111 'Kijk eerst of het tekstwoord-MET-HYPHEN misschien IN Z'N GEHEEL matcht met een dictionary-word-met-hyphen 11007: 'terugkeerpunt, indien dit NIET het geval is: 'MsgBox "tekstwoord-met-hyphen |" & HeleWoord & "| match als geheel NIET met dictionary" HeleWoord = DeelWoord(1) 'herstel oorspronkelijke HeleWoord-string zoals gesaved (als 'default value') boven label 11001 LenWoord = Len(HeleWoord) HyphenInInvoerTekstwoord = False If InstellingsOptie2 Then 'overbodige en foutieve, maar ook expliciet bedoelde hyphens, worden genegeerd: HeleWoordMetHyphens = HeleWoord HeleWoord = HaalHyphensWeg(HeleWoord) LenWoord = Len(HeleWoord) TekstwoordNuZonderHyphen = True GoTo 1 'Test nu of het tekstwoord-ZONDER-HYPHEN misschien IN Z'N GEHEEL matcht met een dictionary-word-zonder-hyphen. 11008: '(tweede) terugkeerpunt, indien dit NIET het geval is: 'MsgBox "ook zonder hyphen matcht |" & HeleWoord & "| als geheel NIET met dictionary" TekstwoordNuZonderHyphen = False HeleWoord = HeleWoordMetHyphens 'herstel de weggehaalde hyphens weer LenWoord = Len(HeleWoord) End If End If 'Controleer nu de afzonderlijke Deelwoorden, of die elk voor zich matchen met dictionary dan wel legale samenstellingen zijn: '--------------------------------------------------------------------------------------------------------------------------------------- 11010: Hyphens11010 = True iDeelWoord = iDeelWoord + 1 DeelWoordBegin(iDeelWoord) = iNextHyphen + 1 DeelWoord(iDeelWoord) = Right(HeleWoord, LenWoord - iNextHyphen) DeelWoord(iDeelWoord - 1) = Left(DeelWoord(iDeelWoord - 1), Len(DeelWoord(iDeelWoord - 1)) - (Len(DeelWoord(iDeelWoord)) + 1)) iHyphen = iNextHyphen If iDeelWoord = 10 Then GoTo 11111 '[ na 9 hyphens komt de hele rest van het woord in Deelwoord(10) ] GoTo 11001 11111: nDeelWoord = iDeelWoord 'bij nDeelWoord=1 is Hyphens=false; DivScoreTekens = "" VoorkeursSamenstDivDeelw = "" AantalGevSamenstDivDeelw = "" ' MsgBox DeelWoord(1) & " | " & DeelWoord(2) & vbCr & _ ' " | " & DeelWoord(3) & " | " & DeelWoord(4) & " | " & DeelWoord(5) '[voor evt. extra check op juiste invoer-verwerking] If Not Hyphens11010 Then GoTo 1 'MsgBox "toch Hyphen aangetroffen" '[30-10-06] TYDELIJKE ATTENDERING 'De deelwoorden 1 t/m nDeelWoord) worden nu apart verwerkt: For iDeelWoord = 1 To nDeelWoord If iDeelWoord = nDeelWoord Then MeestRechtseDeelWoord = True Else MeestRechtseDeelWoord = False oToegevoegd = False k = DeelWoordBegin(iDeelWoord) 'karakter-positie waarop iDeelWoord begint (altijd =1 bij eerste DeelWoord) WoordDeel = DeelWoord(iDeelWoord) '(WoordDeel en DeelWoord hebben identieke betekenis) LenDeel = Len(WoordDeel) If MeestRechtseDeelWoord Then '(Let op: het MeestRechtseDeelWoord wordt altijd als LAATSTE behandeld) 'Woorden die zeker geen Esp.woord zijn (evidente eigennamen) uitfilteren: If CerteFremdlingva(WoordDeel) Then '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = 3 'ROOD maken van NIET-Esp.- DeelWoord DivScoreTekens = DivScoreTekens & "E" ' "E"=aanduiding van Eigennaam of anderstalig woord 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord nCerteFremdlinga = nCerteFremdlinga + 1 GoTo 9 'VortSpecoKodo = "f" '[het komt goed uit dat label 10101 bij dit LAATSTE Deelwoord oversprongen kan worden] End If 'Uitgangen van inhoudswoorden terugbrengen naar Hoofdvorm (-o, -a, -e, -i), door weghalen PostFinaĵoj: If Right(WoordDeel, 2) <> "en" Then ' -en blijft -en '[##ATTENTIE: check het niet-hyphenated macro-deel voor herzieningen ivm ENuitgang!] If Right(WoordDeel, 1) = "n" Then Accusatief = True: WoordDeel = Left(WoordDeel, Len(WoordDeel) - 1) ' -on wordt -o, -an wordt -a, -ojn wordt -oj, -ajn wordt -aj If Right(WoordDeel, 1) = "j" Then Meervoud = True: WoordDeel = Left(WoordDeel, Len(WoordDeel) - 1) ' -oj wordt -o, -aj wordt -a If Right(WoordDeel, 1) = "s" Then Vervoegd = True: WoordDeel = Left(WoordDeel, Len(WoordDeel) - 2) & "i" ' -as wordt -i, -is wordt -i, -os wordt -i, -us wordt -i If Right(WoordDeel, 1) = "u" Then Volitivo = True: WoordDeel = Left(WoordDeel, Len(WoordDeel) - 1) & "i" ' -u wordt -i End If 'Controle: If Not (Right(WoordDeel, 1) = "o" Or Right(WoordDeel, 1) = "a" Or Right(WoordDeel, 1) = "e" Or Right(WoordDeel, 2) = "en" Or Right(WoordDeel, 1) = "i") Then '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = 9 'BRUIN maken van DeelWoord met andere uitgang 'MsgBox "MeestRechtseDeelWoord terugbrengen naar Hoofdvorm NIET gelukt;" & vbCr & _ "mogelijk is het onderdeel van een onbekend hyphenated functiewoord (onomatopee)" nFouteUitgangMeestRechtseDeelWoord = nFouteUitgangMeestRechtseDeelWoord + 1 OnbekendFunctiewoord = True DivScoreTekens = DivScoreTekens & "u" ' "u"= aanduiding van 'Geen goede uitgang' (bijv. -ak ) 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord '.Cells(i, iColumnErvoor).Value = "' !? " 'niet-Esp.-teken zetten in de kolom ervoor [ n' , ter onderscheiding van n ] GoTo 9 'VortSpecoKodo = "x" '[het komt goed uit dat label 10101 bij dit LAATSTE Deelwoord oversprongen kan worden] End If 'Check of het MeestRechtseDeelWoord als geheel bestaat in een van de Dictionaries [Reichling-stelling!]:: MatchStadiumUitgangVariatie = 0 If MatchEspWordToDict(WoordDeel, "BRO", struct, synmark, genvoc, NurAfAuMem) And NurAfAuMem = "" Then GoTo 10091 'BRO is ongeschikt voor het checken van "en"-woorden 'een woord op "en" wordt zowel in BRO, PIV als DICT3 automatisch gematcht op een aparte "en"-kolom [26-8-08] If Not BROonly Then '[22-9-08] If MatchEspWordToDict(WoordDeel, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(WoordDeel, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If Else 'If NOT MeestRechtseDeelWoord Then '(voor WoordDelen Links van het meestrechtse woord moet rekening worden gehouden met Weggelaten Uitgang -o, -a, -e, -en, -i ): If Right(WoordDeel, 1) <> "o" And Right(WoordDeel, 1) <> "a" And Right(WoordDeel, 1) <> "e" _ And Right(WoordDeel, 2) <> "en" And Right(WoordDeel, 2) <> "ii" Then ' "ii" ivm verbs van het type "iluzii" [ 14-11-2005] WoordDeel = WoordDeel & "o" LenDeel = Len(WoordDeel) oToegevoegd = True End If 'DeelWoorden die zeker geen Esp.woord zijn (evidente eigennamen) uitfilteren: If CerteFremdlingva(WoordDeel) Then '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = 3 'ROOD maken van NIET-Esp.- DeelWoord DivScoreTekens = DivScoreTekens & "E" ' "E"=aanduiding van Eigennaam of anderstalig woord 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord nCerteFremdlinga = nCerteFremdlinga + 1 GoTo 10101 End If 'Check of het DeelWoord als geheel bestaat in een van de Dictionaries [Reichling-stelling!]:: If oToegevoegd And Right(WoordDeel, 2) = "io" Then 'haal toegevoegde -o er nog heel even af [*14-11-2005]: WoordDeel = Left(WoordDeel, LenDeel - 1) 'eerst Snelle Check op simpel Verb, van woord op -i (en niet -ii): If MatchEspWordToDict(WoordDeel, "BRO", struct, synmark, genvoc, NurAfAuMem) And NurAfAuMem = "" Then GoTo 10091 '[15-8-08] If Not BROonly Then '[22-9-08] If MatchEspWordToDict(WoordDeel & "S", "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 'met "S"-parameter, om ook prefixen op -i ... If MatchEspWordToDict(WoordDeel & "S", "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 ' ... zoals bijv. "anti" mee te nemen End If WoordDeel = WoordDeel & "o" 'terug naar -io vorm LenDeel = Len(WoordDeel) End If If MatchEspWordToDict(WoordDeel, "BRO", struct, synmark, genvoc, NurAfAuMem) And NurAfAuMem = "" Then GoTo 10091 '[15-8-08] 'BRO is ongeschikt voor het checken van "en"-woorden 'een woord op "en" wordt zowel in BRO, PIV als DICT3 automatisch gematcht op een aparte "en"-kolom [26-8-08] If Not BROonly Then '[22-9-08] If MatchEspWordToDict(WoordDeel, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(WoordDeel, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If If Right(WoordDeel, 2) = "en" Then WoordDeel = WoordDeel & "o" 'geen richtingsaccusatief -"en", maar een geval zoals "subven", dat dus nu "subveno" wordt LenDeel = Len(WoordDeel) oToegevoegd = True If MatchEspWordToDict(WoordDeel, "BRO", struct, synmark, genvoc, NurAfAuMem) And NurAfAuMem = "" Then GoTo 10091 '[15-8-08] If Not BROonly Then '[22-9-08] If MatchEspWordToDict(WoordDeel, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(WoordDeel, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If End If End If 'VARIEER Hoofd-Uitgang indien nog geen succesvolle dictionary-match heeft plaatsgehad: '[22-9-08:] Bij uitgangsvariatie is heroproep van BRO zinloos, omdat BRO geen woorden maar radikoj bevat, en omdat de "S"-parameter bij BRO evenmin tot uitgangsvariatie leidt ! If Not BROonly Then '[22-9-08] If MeestRechtseDeelWoord Then '[dit UitgangsVariatie-blok is gelijk aan dat van de Unhyphenated (vroegere) versie van het macro]: 'Varieer eerst, net als bij unhyphenated woorden, de -o,-a,-e,-i -uitgang (bijv. 'diskrete' staat niet, maar 'diskreta' wel in het Dictionary): If Right(WoordDeel, 1) = "e" Then MatchStadiumUitgangVariatie = 1 'varieer -e -> -a, -i k1 = k1 + 1 woord = Left(WoordDeel, LenDeel - 1) & "S" 'varieer -e -> -a, -i dmv S-kolom (in MatchEspWordToDict) [& "a" vervangen door & "S", op 29-1-07] 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 'Speciale toevoeging voor woorden op -cie (aŭkcie , mutacie ...): 'If LenDeel >= 5 And Right(WoordDeel, 3) = "cie" Then [*dit uitgebreid tot elk woord met e-uitgang, op 29-1-07] MatchStadiumUitgangVariatie = 5 'varieer -e -> -o k5 = k5 + 1 woord = Left(WoordDeel, LenDeel - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 'End If ElseIf Right(WoordDeel, 1) = "a" Then MatchStadiumUitgangVariatie = 2 k2 = k2 + 1 woord = Left(WoordDeel, LenDeel - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 ElseIf Right(WoordDeel, 1) = "o" Then MatchStadiumUitgangVariatie = 3 k3 = k3 + 1 woord = Left(WoordDeel, LenDeel - 1) & "i" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 ElseIf Right(WoordDeel, 1) = "i" Then MatchStadiumUitgangVariatie = 4 k4 = k4 + 1 woord = Left(WoordDeel, LenDeel - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If Else 'If NOT MeestRechtseDeelWoord Then: 'Test (anders dan bij unhyphenated woorden) ALLE 4 de UitgangsVariaties ( -o, -a, -e, -i ): If Right(WoordDeel, 1) <> "o" Then woord = Left(WoordDeel, LenDeel - 1) & "o" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If If Right(WoordDeel, 1) <> "a" Then woord = Left(WoordDeel, LenDeel - 1) & "a" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If If Right(WoordDeel, 1) <> "e" Then woord = Left(WoordDeel, LenDeel - 1) & "e" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If If Right(WoordDeel, 1) <> "i" Then woord = Left(WoordDeel, LenDeel - 1) & "i" 'If MatchEspWordToDict(woord, "BRO", struct, synmark, genvoc, NurAfOpcIV) And NurAfOpcIV = "" Then GoTo 10091 '[22-9-08 gedeaktiveerd] If MatchEspWordToDict(woord, "PIV", struct, synmark, genvoc, Ambigumark) Then GoTo 10092 If MatchEspWordToDict(woord, "DICT3", struct, synmark, genvoc, Ambigumark) Then GoTo 10093 End If '[van de succesvolle variaties van deze niet-meestrechtse hyphenated woorddelen wordt GEEN statistiek bijgehouden] If Not oToegevoegd Then 'Aparte test voor evt. Nouns op -oo, -ao, -eo (NIET op -io) waarvan de uitgangs-o was weggelaten [13-11-2005]: If Right(WoordDeel, 1) = "o" Then If MatchEspWordToDict(WoordDeel, "Exceptions-oo", struct, synmark, genvoc, Ambigumark) Then GoTo 10194 End If If Right(WoordDeel, 1) = "a" Then If MatchEspWordToDict(WoordDeel, "Exceptions-ao", struct, synmark, genvoc, Ambigumark) Then GoTo 10294 End If If Right(WoordDeel, 1) = "e" Then If MatchEspWordToDict(WoordDeel, "Exceptions-eo", struct, synmark, genvoc, Ambigumark) Then GoTo 10394 End If End If End If End If GoTo 10100 'Na succesvolle matching met Dictionary van het WoordDeel (al dan niet na Hoofd-Uitgangs-verandering): 10091: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinBRO = nHeleWoordinBRO + 1 GoTo 10095 10092: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinPIV = nHeleWoordinPIV + 1 GoTo 10095 10093: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinDICT3 = nHeleWoordinDICT3 + 1 GoTo 10095 10194: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinExceptionsOo = nHeleWoordinExceptionsOo + 1 GoTo 10095 10294: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinExceptionsAo = nHeleWoordinExceptionsAo + 1 GoTo 10095 10394: If struct = "FFFFF" Then GoTo 9 '(blacklist-woord) [7-7-08] nHeleWoordinExceptionsEo = nHeleWoordinExceptionsEo + 1 GoTo 10095 10095: '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = 5 'DONKERBLAUW als aanduiding van dictionary-woord DivScoreTekens = DivScoreTekens & "+" ' + = aanduiding dat het WoordDeel matcht met Esp. dictionary 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord 'Telling van succesvolle Hoofd-Uitgangs-veranderingen: If MatchStadiumUitgangVariatie = 1 Then n1 = n1 + 1 If MatchStadiumUitgangVariatie = 2 Then n2 = n2 + 1 If MatchStadiumUitgangVariatie = 3 Then n3 = n3 + 1 If MatchStadiumUitgangVariatie = 4 Then N4 = N4 + 1 If MatchStadiumUitgangVariatie = 5 Then n5 = n5 + 1 GoTo 10101 'Bij NIET-matchen met Dictionary van het WoordDeel (ook bij Niet-matchen na Hoofd-Uitgangs-verandering), 'ga dan na of het WoordDeel misschien een SAMENSTELLING is: 10100: 'MsgBox "ingangs-woord PLUR-makro: |" & WoordDeel & "|" If Not KunmetAnaliz(WoordDeel, VoorkeursSamenstelling, nGevondenSamenstellingen, iPosOptionalHyphen) Then '[30-10-06, ipv 'PlurVortKunmetoEkzist' ] '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = 7 'PAARS maken van NIET-samengesteld Esp.- WoordDeel DivScoreTekens = DivScoreTekens & "-" ' - = aanduiding dat WoordDeel NIET een samengesteld Esp.- woord is (en NIET matcht met Esp. dictionary) 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord If iDeelWoord = nDeelWoord Then 'bij MeestRechtse Deelwoord: GoTo 9 'VortSpecoKodo = "f" '[het komt goed uit dat label 10101 bij dit LAATSTE Deelwoord oversprongen kan worden] End If Else 'MsgBox "WEL samenstelling! VoorkeursSamenst: |" & VoorkeursSamenstelling & "|" '**TEST hiermee '.Cells(i, iColumn).Characters(Start:=k, Length:=LenDeel).Font.ColorIndex = xlAutomatic 'gewoon zwart voor een samengesteld Esp.- WoordDeel DivScoreTekens = DivScoreTekens & "s" ' s = aanduiding dat WoordDeel een SAMENGESTELD Esp.- woord is 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord 'Schrijf alleen de VoorkeursSamenstellingen van 'zwarte' DeelWoorden in de aparte kolom (gescheiden door verticaal streepje ): If VoorkeursSamenstDivDeelw <> "" Then VoorkeursSamenstDivDeelw = VoorkeursSamenstDivDeelw & " | " 'If oToegevoegd Then VoorkeursSamenstelling(0) = Left(VoorkeursSamenstelling(0), Len(VoorkeursSamenstelling(0)) - 1) 'MsgBox "VoorkeursSamenstelling na correctie= |" & VoorkeursSamenstelling(0) & "|" '######## 7-11-06: liep vast op bovenstaand stmt (Len=0) VoorkeursSamenstDivDeelw = VoorkeursSamenstDivDeelw & VoorkeursSamenstelling(0) '.Cells(i, iColumnVoorkeurKunmet).Value = VoorkeursSamenstDivDeelw 'VoorkeursSamenstelling wordt via de 1e parameter van dit macro teruggemeld, waarbij... [*23-12-2005] 'TeTestenWoord = SpecDividSignoOnDoubleSpace(VoorkeursSamenstDivDeelw) '...elke dubbele spatie wordt vervangen door een speciaal hyphen '[30-10-06: TeTestenWoord nu alleen nog invoerparameter] 'Schrijf alleen de aantallen Gevonden Samenstellingen van 'zwarte' DeelWoorden in de aparte kolom (gescheiden door verticaal streepje ): If AantalGevSamenstDivDeelw <> "" Then AantalGevSamenstDivDeelw = AantalGevSamenstDivDeelw & " | " AantalGevSamenstDivDeelw = AantalGevSamenstDivDeelw & nGevondenSamenstellingen '.Cells(i, iColumnAantalKunmet).Value = AantalGevSamenstDivDeelw nSamengesteldEspWoord = nSamengesteldEspWoord + 1 End If 10101: 'Deelwoord behandeld (de al dan niet goedkeuring van Esp. woord of samenstelling ... ' ... is af te lezen uit de string DivScoreTekens): '.Cells(i, iColumnErvoor).Value = HyphenWoordScore 'MsgBox "van |" & HeleWoord & "| is deelwoord = " & iDeelWoord & " afgewerkt;" & vbCr & _ "DivScoreTekens = " & DivScoreTekens Next iDeelWoord 'Na het testen van alle afzonderlijke Deelwoorden wordt als VortSpeco van het hele hyphenated woord ... '...de VortSpeco van het MeestRechtse Deelwoord teruggemeld, via de tweede parameter van dit macro. In verband daarmee geldt: HeleWoord = WoordDeel '[om programtechnische redenen: het hierna te doorlopen blok 10 wordt ook voor unhyphenated woorden gebruikt]. 'Een detail-analyse van het hyphenated woord wordt compact (bijv. "H1++" ) samengevat in de string HyphenWoordScore: 'HyphenWoordScore = "H" & iDeelWoord - 1 & DivScoreTekens ' "H"=Hyphenated woord; iDeelWoord-1 = Aantal Hyphens in woord 'Deze string wordt via de derde parameter van dit macro teruggemeld, en volgens bovenstaande formule samengesteld onder label 90909 ... '...[na doorlopen van blok 10 of van label 9]. GoTo 10 '[ naar label 9 (negatieve VortSpeco "f" of "x") wordt vanuit 3 plaatsen in bovenstaande code direct gesprongen] '------------------------------------------------einde speciale verwerkingsblok 'Hyphenated'------------------------------------------------------------------- 999: End Sub Function CerteFremdlingva(woord As String) As Boolean 'ESPSOF Versio 0.9 4 oktobro 2008 TW (Toon Witkam) 'tiu ĉi funkcio rezultigas la valoron 'True' nur se ĝi konstatis kun certeco ke la enirvorto NE estas Esperanta vorto 'van een gegeven woord wordt onderzocht of het een NIET-Esperanto-woord is: 'uitkomst 'true' betekent: "er is met zekerheid vastgesteld dat dit GEEN Esperanto-woord is" 'uitkomst 'false' betekent: "er is NIET met zekerheid vastgesteld dat dit GEEN Esperanto-woord is" Dim Word As String Dim WordLength As Integer Dim iChar As Integer Dim k As Long 'k = Ascii/Unicode Dim T1 As String Dim T2 As String Dim T3 As String Dim T4 As String Dim T5 As String Dim T6 As String Dim T7 As String Dim H2 As String Dim H3 As String Dim H4 As String Dim H5 As String Dim H6 As String Dim H7 As String Dim M2 As String Dim Stam As String Dim S2 As String Dim S3 As String CerteFremdlingva = False If woord = "" Or woord = " " Then GoTo 90 'lege cel WordLength = Len(woord) If WordLength = 1 Then GoTo 70 '1-letter Esp-woorden bestaan niet 'Hoofdletterverwijdering hier afgezet [*24-11-2005] omdat het oproepende macro (CheckEspWord) daar al voor zorgt: 'Word = BeginHoofdletterWeg(woord) 'Converteer (alleen tijdelijk) Beginhoofdletter... 'Word = VolgHoofdlettersWeg(Word) '...en evt. verdere hoofdletters naar kleine letter Word = woord 'If Word = "dank'al" Then GoTo 90 'ivm toelating van "dank'al" zonder spatie '[4-10-2008] <== overbodig! 'If Word = "dank'al" Or Word = "dank" & ChrW(8217) & "al" Then GoTo 90 'ivm toelating van "dank'al" zonder spatie '[4-10-2008] <== overbodig! 'Niet-lettertekens mogen in het woord niet voorkomen : For iChar = 1 To WordLength k = AscW(Mid(Word, iChar, 1)) 'If k = 32 And Not iChar = WordLength Then GoTo 70 '*****SPECIAL MODE 1: Test alleen op SPATIE in woord 'If k = 126 Then GoTo 70 '*****SPECIAL MODE 2: Test alleen op TILDE in of aan eind van woord If k <= 96 And Not ((k >= 48 And k <= 57) Or k = 45) Then GoTo 70 'NORMALE MODUS 'uitzondering: de gewone cijfers (Ascii 48 t/m 57), en de gewone hyphen (Ascii 45) Next iChar 'GoTo 90 '***** bij SPECIAL MODES: Test alleen op SPATIE of TILDE If Word = "l" & ChrW(8217) Then GoTo 90 '[5-12-05:] lidwoord "la" met elisie (standaard apostrof 8217 ipv "a") is NIET fremdlingva! '****ga verder na of APOSTROPH (Ascii 39 of Unicode 8217) doorgelaten wordt door AZM-macros (bijv.: dank'al, O'Connor, etc) For iChar = 1 To WordLength 'Check op NIET-Esp-letters: k = AscW(Mid(Word, iChar, 1)) 'Een q, w, x of y betekent: GEEN Esp-woord: If k = 113 Or (k >= 119 And k <= 121) Then GoTo 70 'Elke vreemde of geaccentueerde letter, anders dan de 6 diakritische Esp-letters, betekent: GEEN Esp-woord: If k >= 123 And Not (k = 265 Or k = 285 Or k = 293 Or k = 309 Or k = 349 Or k = 365) Then GoTo 70 Next iChar 'N.B. Een diakritische Esp-letter (ĉ, ĝ, ĥ, ĵ, ŝ, of ŭ) in het woord betekent nog NIET dat... '...het woord niet Fremdlingva zou kunnen zijn (denk aan bijv.: Ŝirjaev, Ĥruŝĉev, Ŝidlovskaja...) 'Trigrammen die nooit ergens in een Esp-woord voor kunnen komen, 'ook niet als dat woord een samengesteld woord is: 'MsgBox "bij Trigrammen" If InStr(2, Word, "chl") > 0 Then GoTo 70 '(Instr-stmts met startwaarde 2: optreden trigram... If InStr(2, Word, "chr") > 0 Then GoTo 70 '...aan begin woord wordt pas hieronder gedetecteerd bij... If InStr(2, Word, "ghl") > 0 Then GoTo 70 '...checken op bigram aan voorkant woord) If InStr(2, Word, "phl") > 0 Then GoTo 70 If InStr(2, Word, "phr") > 0 Then GoTo 70 If InStr(1, Word, "sch") > 0 Then GoTo 70 If InStr(2, Word, "tsj") > 0 Then GoTo 70 'Consonant-bigrammen die nooit aan de voorkant ('Head') van een Esp-woord voor kunnen komen: H2 = Left(Word, 2) 'ch, cl, cr, cs, cn, cz, gh, sh, sj, sz, th, ts, zj, kh, ng, ph (uitzondering: ghetto ) If H2 = "ch" Or H2 = "cl" Or H2 = "cr" Or H2 = "cs" Or H2 = "cn" Or H2 = "cz" Or (H2 = "gh" And Left(Word, 5) <> "ghett") Or _ H2 = "sh" Or H2 = "sj" Or H2 = "sz" Or H2 = "th" Or H2 = "ts" Or H2 = "zj" Or H2 = "kh" Or H2 = "ng" Or H2 = "ph" Then GoTo 70 'Letters/bigrammen/trigrammen die nooit aan de achterkant ('Tail') van een Esp-woord voor kunnen komen: 'MsgBox "bij Letters/bigrammen/trigrammen" T1 = Right(Word, 1) T2 = Right(Word, 2) T3 = Right(Word, 3) T4 = Right(Word, 4) T5 = Right(Word, 5) T6 = Right(Word, 6) T7 = Right(Word, 7) If T1 = "a" Then ' a (UITZONDERING: alle adjectief-uitgangen NOMINATIEF enkelvoud, alsmede: la, da, ja, tra ) If T3 = "cha" Or T3 = "tja" Or T3 = "hia" Or T3 = "fka" Or T4 = "rtha" Or (T4 = "osma" And Not T5 = "kosma") Or _ (T4 = "stma" And Not T5 = "astma") Then GoTo 70 '(ivm namen als: Kafka, Martha, Bosma, Postma ) If T5 = "lstra" Or (T5 = "nstra" And Not T7 = "monstra") Then GoTo 70 '(uitzondering: -monstra [demonstra] ) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -a), of op te korte woorden: If WordLength >= 3 And Left(T3, 1) = Left(T2, 1) And Not (Word = "brutta" Or Word = "finna" Or Word = "galla" Or _ T5 = "vatta") Then GoTo 70 '(uitzondering.: brutta, finna, galla, -vatta ) If WordLength = 2 And Not (Word = "la" Or Word = "da" Or Word = "ja" Or Word = "ia" Or Word = "ha") Then GoTo 70 GoTo 40 '(uitzondering: la, da, ja, ia, ha ) End If If T1 = "b" And Not (Word = "sub") Then GoTo 70 ' b (uitzondering: sub ) If T1 = "c" Then GoTo 70 ' c If T1 = ChrW(265) And Not (Word = "e" & ChrW(265)) Then GoTo 70 ' ĉ (uitzondering: eĉ ) If T1 = "d" And Not (Word = "sed" Or Word = "apud") Then GoTo 70 ' d (uitzondering: sed, apud ) If T1 = "e" Then ' e (UITZONDERING: alle adverbiun-uitgangen, alsmede: de, je, ke, ĉe ) If (T2 = "he" And Not Word = "he") Or T3 = "tje" Then GoTo 70 '(ivm o.a. Duitse namen op -he, -che, -sche en Nederlandse namen op -tje ) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -e), of op te korte woorden: If WordLength >= 3 And Left(T3, 1) = Left(T2, 1) And Not (Word = "brutte" Or Word = "finne" Or Word = "galle" Or _ T5 = "vatte") Then GoTo 70 '(uitzondering: brutte, finne, galle, -vatte ) If WordLength = 2 And Not (Word = "de" Or Word = "ke" Or Word = "se" Or Word = ChrW(265) & "e" Or Word = "ne" Or _ Word = "je" Or Word = "ie" Or Word = "ve" Or Word = "he") Then GoTo 70 '(uitzondering: de, ke, se, ĉe, ne, je, ie, ve, he) If T3 = "vre" Or T4 = "tzke" Then GoTo 70 '(ivm namen als: Lefevre, Maletzke ) GoTo 40 End If If T1 = "f" Then GoTo 70 ' f If T1 = "g" Or T1 = ChrW(285) Then GoTo 70 ' g , ĝ If T1 = "h" Or (T1 = ChrW(293) And Not T2 = "a" & ChrW(293)) Then GoTo 70 ' h , ĥ (uitz.: aĥ ) If T1 = "i" Then ' i (UITZONDERING: infinitief-uitgangen, nominatief-uitgangen pers. vnw., alsmede: ĉi, pli, pri, tri ) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -i), of op te korte woorden: If WordLength >= 3 And Left(T3, 1) = Left(T2, 1) Then GoTo 70 If WordLength = 2 And Not (Word = "mi" Or Word = "vi" Or Word = "li" Or Word = ChrW(349) & "i" Or Word = ChrW(285) & "i" Or _ Word = "ni" Or Word = "si" Or Word = "ci" Or Word = ChrW(265) & "i" Or Word = "fi") Then GoTo 70 '(uitzondering: mi, vi, li, ŝi, ĝi, ni, si, ci, ĉi, fi ) 'Ivm Aziatisch namen op -oi, -ai (uitzondering: vetoi, forvetoi, balai, forbalai, hurai, iai, troi): ["troi" toegevoegd 17-9-08] If (T2 = "oi" And Not (T5 = "vetoi" Or Word = "troi")) Or (T2 = "ai" And Not (T5 = "balai" Or Word = "hurai" Or Word = "iai")) Then GoTo 70 GoTo 40 End If If T1 = "j" Then ' j (UITZONDERING: alle uitgangen NOMINATIEF meervoud, alsmede: kaj, tuj, plej, malplej ) If Not (Left(T2, 1) = "o" Or Left(T2, 1) = "a") Then GoTo 70 '[24-5-08] (naar aanleiding van "Vitalij" in Metropoliteno) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -oj), of op te korte woorden: If WordLength >= 4 And Left(T4, 1) = Left(T3, 1) And _ Not (Word = "annoj" Or Word = "finnoj" Or Word = "galloj" Or Word = "ghettoj" Or Word = "regattoj" Or T6 = "vattoj" Or Word = "vendettoj" Or Word = "finnaj" Or _ Word = "gallaj" Or T6 = "vattaj" Or Word = "pulloj") Then GoTo 70 '(uitzondering.: annoj, finnoj, galloj, ghettoj, pulloj, regattoj, -vattoj, vendettoj, finnaj, gallaj, -vattaj ) If WordLength <= 3 And Not (Word = "aj" Or Word = "kaj" Or Word = "tuj" Or Word = "iuj") Then GoTo 70 '(uitzondering: kaj, tuj, iuj ) GoTo 40 End If If T1 = "k" And Not (Word = "ek" Or Word = "nek" Or Word = "dank" Or Word = "ok" Or T3 = "dek" Or Word = "ruk") Then GoTo 70 ' k '(Nederlandse namen als: Broek, Dijk, Kraak, vallen hierdoor af) If T1 = "l" Then ' l (uitzondering: al, el, iel, kiel, tiel, ĉiel, neniel, aliel, estiel, samkiel, ial, kial, tial, ĉial, nenial, ol, mil, nul) If Not (Word = "al" Or Word = "ial" Or Word = "kial" Or Word = "tial" Or Word = ChrW(265) & "ial" Or Word = "nenial" Or _ Word = "el" Or Word = "iel" Or Word = "kiel" Or Word = "tiel" Or Word = ChrW(265) & "iel" Or Word = "neniel" Or Word = "aliel" Or Word = "ol" Or _ Word = "mil" Or Word = "nul" Or Word = "estiel" Or Word = "samkiel" Or Word = "samekiel" Or Word = "iel-tiel") Then GoTo 70 GoTo 40 End If If T1 = "m" Then ' m (uitzondering: dum, jam, mem, krom, kvankam, iam, kiam, tiam, ĉiam, neniam, iom, kiom, tiom, ĉiom, neniom, kelkiom ) If Not (Word = "dum" Or Word = "jam" Or Word = "kvankam" Or Word = "krom" Or Word = "mem" Or _ Word = "iom" Or Word = "kiom" Or Word = "tiom" Or Word = ChrW(265) & "iom" Or Word = "neniom" Or Word = "kelkiom" Or _ Word = "iam" Or Word = "kiam" Or Word = "tiam" Or Word = ChrW(265) & "iam" Or Word = "neniam") Then GoTo 70 GoTo 40 End If If T1 = "n" Then ' n (UITZONDERING: alle ACCUSATIEF-uitgangen, ook meervouds-accusatief; ... If Not (T2 = "on" Or T2 = "an" Or T2 = "en" Or T2 = "in" Or T2 = "un" Or T3 = "ojn" Or T3 = "ajn" Or T3 = "ujn") Then GoTo 70 '...en in het bijzonder: min, vin, lin, ŝin, ĝin, nin, cin, ilin, onin, sin, kvin, nun, kun, unun, kelkiun, iun, kiun, tiun, ĉiun, neniun, iujn, kiujn, tiujn, ... ) If T2 = "in" And Not (Word = "min" Or Word = "vin" Or Word = "lin" Or Word = ChrW(349) & "in" Or Word = ChrW(285) & "in" Or _ Word = "nin" Or Word = "cin" Or Word = "ilin" Or Word = "onin" Or Word = "sin" Or Word = "kvin") Then GoTo 70 If T2 = "un" And Not (Word = "nun" Or Word = "kun" Or Word = "unun" Or Word = "kelkiun" Or _ Word = "iun" Or Word = "kiun" Or Word = "tiun" Or Word = ChrW(265) & "iun" Or Word = "neniun") Then GoTo 70 If T3 = "ujn" And Not (Word = "iujn" Or Word = "kiujn" Or Word = "tiujn" Or Word = ChrW(265) & "iujn" Or Word = "neniujn" Or _ Word = "kelkiujn") Then GoTo 70 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -on, -an, -en, -ojn, -ajn), of op te korte woorden: If (T2 = "on" Or T2 = "an" Or T2 = "en") And WordLength >= 4 And Left(T4, 1) = Left(T3, 1) And _ Not (Word = "annon" Or Word = "finnon" Or Word = "gallon" Or Word = "ghetton" Or Word = "regatton" Or T6 = "vatton" Or Word = "vendetton" Or Word = "finnan" Or _ Word = "gallan" Or T6 = "vattan" Or Word = "pullon") Then GoTo 70 '(uitzondering: annon, finnon, gallon, ghetton, pullon, regatton, -vatton, vendetton, finnan, gallan, -vattan) If (T3 = "ojn" Or T3 = "ajn") And WordLength >= 5 And Left(T5, 1) = Left(T4, 1) And _ Not (Word = "annojn" Or Word = "finnojn" Or Word = "gallojn" Or Word = "ghettojn" Or Word = "regattojn" Or T7 = "vattojn" Or Word = "vendettojn" Or Word = "finnajn" Or _ Word = "gallajn" Or T7 = "vattajn" Or Word = "pullojn") Then GoTo 70 '(uitzondering: annojn, finnojn, gallojn, ghettojn, pullojn, regattojn, vattojn, vendettojn, finnajn, gallajn, -vattajn ) If WordLength <= 3 And (T2 = "on" Or T2 = "an" Or T2 = "en") And Not (Word = "en" Or Word = "jen" Or Word = "sen" Or Word = "ien" Or Word = "ion") Then GoTo 70 If WordLength <= 4 And (T3 = "ojn" Or T3 = "ajn") And Not (Word = "ajn") Then GoTo 70 '(uitzondering: jen, sen, ion ) 'Ivm Nederlandse/Duitse namen als: Jansen, Pietersen, Klein ( Hofmann is vier IF-stmts hierboven al afgevangen) : If (T3 = "sen" And Not (Word = "sen" Or Word = "disen" Or Word = "dorsen" Or Word = "transen" Or Word = ChrW(265) & "i-transen" _ Or Word = "renversen")) Or T3 = "ein" Then GoTo 70 '(uitz.: sen, disen, dorsen, transen, ĉi-transen, renversen ) 'Ivm met Nederlandse/Engelse namen als: Bosman, Postman: If (T4 = "sman" And Not (T5 = "asman" Or T5 = "isman" Or T6 = "kosman")) Or (T5 = "stman" And Not T6 = "astman") Then GoTo 70 'Enkele bigrammen/trigrammen die nooit aan het eind van de Stam een Esp-woord voor kunnen komen: If T2 = "on" Then 'Ivm Engels/Amerikaanse namen op -son : Stam = Left(Word, WordLength - 2) S2 = Right(Stam, 2) 'de volgende bi- en trigrammen kunnen volgens Schuetz-vortaro... S3 = Right(Stam, 3) '...niet aan het eind van de stam van een Esperanto-noun optreden: If S2 = "bs" Or S2 = "cs" Or S2 = "ds" Or S2 = "fs" Or S2 = "gs" Or S2 = "hs" Or S2 = "ss" Or S2 = "ts" Then GoTo 70 If S3 = "cks" Or S3 = "hns" Or S3 = "ins" Or S3 = "rls" Then GoTo 70 'bijv. Jackson, Johnson, Robinson, Carlson End If If T4 = "hen" Then GoTo 70 '(ivm o.a. Duitse namen op -hen, -chen, -schen ) GoTo 40 End If If T1 = "o" Then ' o (UITZONDERING: alle substantief-uitgangen NOMINATIEF enkelvoud, alsmede: do, po, pro, tro, ho ) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -o), of op te korte woorden: If WordLength >= 3 And Left(T3, 1) = Left(T2, 1) And Not (Word = "anno" Or Word = "finno" Or Word = "gallo" Or Word = "ghetto" Or Word = "vendetto" Or _ Word = "regatto" Or T5 = "vatto" Or Word = "pullo") Then GoTo 70 '(uitzondering: anno, finno, gallo, ghetto, pullo, regatto, -vatto, vendetto ) If WordLength = 2 And Not (Word = "do" Or Word = "po" Or Word = "io" Or Word = "ho") Then GoTo 70 '(uitz.: do, po, io, ho ) If T3 = "cho" Or (T3 = "zlo" And Not (T5 = "guzlo" Or T5 = "puzlo" Or T6 = "drizlo")) Then GoTo 70 '(ivm namen op -cho, -zlo ) GoTo 40 End If If T1 = "p" And Not (Word = "sep" Or Word = "hop") Then GoTo 70 'p (uitzondering: sep, hop) If T1 = "r" Then ' r (uitzondering: ĉar, far, kvar, per, super, preter, inter, ekster, for, por, plur, nur, sur ) If Not (Word = ChrW(265) & "ar" Or Word = "far" Or Word = "kvar" Or Word = "per" Or _ Word = "super" Or Word = "preter" Or Word = "inter" Or Word = "ekster" Or _ Word = "for" Or Word = "por" Or Word = "plur" Or Word = "nur" Or Word = "sur") Then GoTo 70 GoTo 40 End If If T1 = "s" Then ' s (UITZONDERING: alle verbale uitgangen, alsmede: ĵus, plus, minus, ĝis, bis, trans... If Not (T2 = "as" Or T2 = "is" Or T2 = "os" Or T2 = "us" Or T2 = "es" Or Word = "trans") Then GoTo 70 '...en verder: ies, kies, ties, ĉies, nenies, kelkies, jes, ses, des ) If T2 = "es" And Not (Word = "ies" Or Word = "kies" Or Word = "ties" Or Word = ChrW(265) & "ies" Or Word = "nenies" Or _ Word = "kelkies" Or Word = "jes" Or Word = "ses" Or Word = "des") Then GoTo 70 '(geldt ook voor Nederlandse woorden op -jes, -tjes ) If (T2 = "as" Or T2 = "is" Or T2 = "os" Or T2 = "us") And WordLength < 4 And _ Word <> ChrW(309) & "us" And Word <> ChrW(285) & "is" And Word <> "bis" Then GoTo 70 'te klein voor finite verb If T3 = "aas" And Not (T6 = "balaas" Or Word = "huraas" Or Word = "iaas") Then GoTo 70 'onmogelijke dubbelvocalen... If T3 = "oos" And Not (T6 = "vetoos") Then GoTo 70 '...uitgezonderd vier vervoegde vormen (van: vetoi, balai, hurai, iai) '(Nederlandse/Duitse namen als: Bartjes, Karstens, Gross zijn vier of vijf IF-stmts hierboven al afgevallen) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de verbale uitgang -as, -is, -os, -us), of op te korte woorden: If WordLength >= 4 And Left(T4, 1) = Left(T3, 1) Then GoTo 70 If WordLength <= 3 And (T2 = "as" Or T2 = "is" Or T2 = "os" Or T2 = "us") And Not (Word = ChrW(285) & "is" Or Word = ChrW(309) & "us" Or _ Word = "bis" Or Word = "hu" & ChrW(349)) Then GoTo 70 '(uitzondering: ĝis, ĵus, bis, huŝ ) GoTo 40 End If If T1 = "t" And Not (Word = "post" Or Word = "depost" Or T4 = "cent") Then GoTo 70 ' t (uitzondering: post, depost, cent, ducent, tricent...) If T1 = "u" Then ' u (UITZONDERING: imperatief-uitgangen, alsmede: ĉu, ju, nu, plu, unu, du ) 'Check op dubbelconsonanten of dubbelvocalen aan het eind van de Stam (direct voor de uitgang -u), of op te korte woorden: If WordLength >= 3 And Left(T3, 1) = Left(T2, 1) Then GoTo 70 If WordLength = 2 And Not (Word = ChrW(265) & "u" Or Word = "nu" Or Word = "ju" Or Word = "iu" Or Word = "du" Or Word = "hu") _ Then GoTo 70 '(uitzondering: ĉu, nu, ju, iu, du, hu ) If (T2 = "au" And Not (T5 = "balau" Or Word = "hurau" Or Word = "iau")) Or (T2 = "ou" And Not T5 = "vetou") Then GoTo 70 GoTo 40 '(ivm namen op -au, ou ) End If If T1 = "v" Then GoTo 70 ' v If T1 = "z" Then GoTo 70 ' z 40: 'MsgBox "bij 40" 'Interjecties zijn reeds in het bovenstaande opgenomen ( aĥ, aj, fi, ha, he, ho, ruk, hop, hu, huŝ, ve ). 'Check op Onomatopeeen ( bum, puf, krak, kluk, glu, kva, kŭak, pip, bam, tin, kokeriko, tik-tak, pif-paf, ŭa): If WordLength <= 4 Then If Word = "bum" Or Word = "puf" Or Word = "krak" Or Word = "kluk" Or Word = "glu" Or Word = "kva" Or Word = "kŭak" Or _ Word = "pip" Or Word = "bam" Or Word = "tin" Or Word = "ŭa" Then GoTo 90 End If If WordLength >= 7 Then If Word = "kokeriko" Or Word = "tik-tak" Or Word = "pif-paf" Then GoTo 90 End If 50: 'MsgBox "bij 50" 'Een Esp-woord kan nooit met twee gelijke letters ( aa-, bb-, cc-, dd-, ee-, .....) beginnen: 'H2 = Left(Word, 2) If Left(H2, 1) = Right(H2, 1) Then If Not H2 = "oo" Then GoTo 70 If Not (H5 = "oolit" Or H5 = "oomik" Or H5 = "oosfe" Or H5 = "oospo" Or H5 = "ootos") Then GoTo 70 GoTo 90 '(uitzondering: oolito, oomikotoj, oosfero, oosporo, ootosalpingo ) End If H3 = Left(Word, 3) H4 = Left(Word, 4) H5 = Left(Word, 5) H6 = Left(Word, 6) H7 = Left(Word, 7) 'Vocaal-bigrammen die nooit aan de voorkant ('Head') van een Esp-woord voor kunnen komen: ' eu, ei, oi, au, ua, ui, uo (uitzonderingsloos): If H2 = "eu" Or H2 = "ei" Or H2 = "oi" Or H2 = "au" Or H2 = "ua" Or H2 = "ui" Or H2 = "uo" Then GoTo 70 If (H2 = "ea" And Not (H4 = "east")) Then GoTo 70 '(uitz.: easto ) If (H2 = "oa" And Not (H3 = "oaz")) Then GoTo 70 '(uitz.: oazo ) If (H2 = "oe" And Not (H4 = "oero" Or H5 = "oestr")) Then GoTo 70 '(uitz.: oero, oestro ) If (H2 = "ou" And Not (H3 = "ouz")) Then GoTo 70 '(uitz.: ouzo ) If (H2 = "ae" And Not (H3 = "aed" Or H3 = "aer")) Then GoTo 70 '(uitz.: aedo, aero ) If (H2 = "ai" And Not (H5 = "aides" Or H5 = "aidos" Or H5 = "aikid" Or H4 = "aino" Or H4 = "airo" Or H5 = "aizoo" Or _ H6 = "aizoac" Or H6 = "ailant")) Then GoTo 70 '(uitzondering: aideso, aidoso, aikido, ailanto aino, airo, aizoo, aizoaco ) If (H2 = "ao" And Not (H4 = "aort")) Then GoTo 70 '(uitz.: aorto ) If (H2 = "ue" And Not (H3 = "ued" Or H4 = "uest")) Then GoTo 70 '(uitz.: uedo, uesto ) 'Vocaal-bigrammen die nooit op 2e LetterPositie vanaf de voorkant ('Head') van een Esp-woord voor kunnen komen '(voor 3e en volgende letterposities zijn zulke categorische uitsluitingen niet mogelijk, ivm met het kunnen optreden van VortKunmetoj): 'MsgBox "bij Vocaal-bigrammen op 2e LetterPositie" M2 = Mid(Word, 2, 2) If M2 = "ee" And Not (H3 = "dee" Or H3 = "gee" Or H3 = "nee" Or H3 = "ree" Or H3 = "tee" Or H3 = ChrW(265) & "ee") Then GoTo 70 '(voorbeelden van uitzondering: deterna, deekstere, ĉeesto, geedzoj geedziĝo, neelirebla, reelektebleco, teejo, teeroj ) If M2 = "ea" Then If Not (H5 = "beata" Or H6 = "beatec" Or H6 = "beatif" Or H6 = "beatig" Or H6 = "deadmo" Or H6 = "deapar" Or H6 = "deankr" Or _ H6 = "dearti" Or H3 = ChrW(265) & "ea" Or H3 = "dea" Or H3 = "gea" Or H3 = "nea" Or H3 = "rea" Or H3 = "fea" Or H4 = "pean" Or H4 = "team" Or H4 = "vead" Or _ H5 = "meand" Or H5 = "seanc" Or H6 = "teacoj" Or H5 = "tearb" Or H5 = "teatr" Or H5 = "veasp") Then GoTo 70 '(uitzondering: beata, beateco, beatigi, beatifikaci/, deadmon/, deaparti/, deankri/, deartiki/, ' ĉea/, dea/, gea/, nea/, rea/, fea, peano, teamo, veado, maendr/, seanco, teacoj, tearb/, teatr/, veaspekt/, ĉearbar/ ) GoTo 90 End If If M2 = "ei" Then If Not (H3 = "bei" Or H3 = "nei" Or H3 = "rei" Or H3 = "vei" Or H4 = "deig" Or H4 = "dei" & ChrW(285) Or H4 = "dein" Or H4 = "deir" Or H4 = "fein" Or _ H4 = "geig" Or H4 = "gei" & ChrW(285) Or H4 = "tein" Or H5 = "deism" Or H5 = "deist" Or H5 = "seism" Or H5 = "teism" Or H5 = "teist" Or _ H5 = "keiro" Or H6 = "keiran" Or H7 = "geinstr") Then GoTo 70 GoTo 90 '(uitzondering: bei, nei/, rei/, vei, deig/, deiĝ/, deino, deiri, feino, geig/, geiĝ/, teino, deismo, deisto, seismo, teismo, teisto, keiro, keiranto, geinstruistoj ) End If If M2 = "eu" And Not (H4 = "geul" Or H4 = "geum" Or H4 = "neuz" Or H4 = "reuz" Or H4 = "reun" Or H4 = "teuj" Or H5 = ChrW(265) & "eurb" Or H5 = "neurb" Or _ H6 = "neutil" Or H6 = "reutil") Then GoTo 70 '(uitzondering: geulo, geumo, neuz/, reuz/, reun/, teujo, ĉeurb/, neurb/, neutil/, reutil/ ) If M2 = "oo" And Not (H4 = "booj" Or H3 = "goo" Or H3 = "poo" Or H3 = "zoo" Or H5 = "koord" Or H5 = "koopt" Or H6 = "kooper") Then GoTo 70 '(uitzondering: booj, goo, poo, zoo/, koord/, koopt/, kooper/ ) If M2 = "oe" Then If Not (H4 = "poem" Or H4 = "poet" Or H5 = "boedz" Or H6 = "goelet" Or H5 = "poent" Or H5 = "poezi" Or _ H6 = "koefic" Or H6 = "koekzi" Or H6 = "noetik" Or H6 = "poefag" Or H5 = "koelo" Or H6 = "koendu") Then GoTo 70 '(uitzondering: poemo, poeto, boedz/, goeleto, poento, poezi/, koeficiento, koekzist/, noetiko, poefago, koelo, koendulo) GoTo 90 End If If M2 = "oi" Then If Not (H4 = "boi" & ChrW(285) Or H4 = "foin" Or H4 = "foir" Or H4 = "koit" Or H4 = "soif" Or Left(Word, 8) = "pointero" Or Left(Word, 8) = "poiomete" Or _ H6 = "koinci") Then GoTo 70 '(uitzondering: boiĝ/, foino, foiro, koit/, soif/, pointero, poiomete, koincid/ ) GoTo 90 End If If M2 = "ou" Then GoTo 70 '(uitzonderingsloos) If M2 = "aa" And Not (H4 = "maat") Then GoTo 70 '(uitzondering: maato ) If M2 = "ae" And Not (H3 = "iae" Or H4 = "gael" Or H6 = "paeljo" Or H5 = "taelo" Or H7 = "faetono") Then GoTo 70 If M2 = "ai" Then '(uitzondering: iae/ [bijv.: iaepoke ], gaela, paeljo, taelo, faetono ) If Not (H3 = "iai" Or H4 = "laik" Or H4 = "maiz" Or H4 = "naiv" Or H4 = "gain" Or _ H5 = "daimi" Or H5 = "vai" & ChrW(349) & "j") Then GoTo 70 '(uitzondering: iai, laiko, maizo, naiv/, gaino, daimio, vaiŝjo ) GoTo 90 End If If M2 = "ao" Then If Not (H4 = ChrW(293) & "aos" Or H4 = "kaos" Or H6 = "kaolin" Or H5 = "kaono" Or H5 = "laosa" Or H5 = "taois" Or _ H6 = "baobab" Or H5 = "maori") Then GoTo 70 '(uitzondering: ĥaos/, kaos/, kaolin/, kaono, laosa, taoismo/taoisto, baobabo, maorio, maoria ) GoTo 90 End If If M2 = "au" And Not (H5 = "saudi") Then GoTo 70 '(uitzondering: saudi-/ [saudi-arabia] ) If M2 = "uu" And Not (H4 = "duul" Or H4 = "duum" Or H3 = ChrW(285) & "uu" Or H3 = "luu" Or H3 = "ruu") Then GoTo 70 '(uitzondering: duulo, duuma, ĝuu/, luu/, ruu/ ) If M2 = "ua" Then If Not (H3 = "dua" Or H4 = "guan" Or H3 = ChrW(285) & "ua" Or H3 = "lua" Or H4 = "muar" Or H5 = "nuanc" Or H4 = "ruan" Or _ H3 = ChrW(349) & "ua" Or H6 = "tualet" Or H4 = "vual" Or H4 = "gua" & ChrW(349) Or H5 = "zuavo") Then GoTo 70 '(uitzondering: dua/, guano, ĝua/, lua/, muar/, nuanc/, ruana, ŝuaĵo, tualet/, vual/, guaŝo, zuavo ) GoTo 90 End If If M2 = "ue" Then If Not (H3 = "due" Or H4 = "fuel" Or H3 = ChrW(285) & "ue" Or H4 = "lues" Or H4 = "muel" Or H4 = "muez" Or _ H6 = "puerpe") Then GoTo 70 '(uitzondering: due/, fuel/, ĝue/, lueso, muel/, muez/, puerper/ ) GoTo 90 End If If M2 = "ui" Then If Not (H3 = ChrW(285) & "ui" Or H4 = "kuir" Or H3 = "lui" Or H3 = "rui" Or H4 = "suic" Or H4 = "suit" Or _ H5 = ChrW(349) & "uist") Then GoTo 70 '(uitzondering: ĝui/, kuir/, lui/, rui/, suic/, suito, ŝuisto ) GoTo 90 End If If M2 = "uo" Then If Not (H3 = "buo" Or H3 = "duo" Or H5 = "fuort" Or H3 = ChrW(285) & "uo" Or H3 = "kuo" Or H3 = "luo" Or H4 = "suom" Or _ H3 = ChrW(349) & "uo" Or H5 = "muono") Then GoTo 70 '(uitzondering: buo, duo/, fuorto, ĝuo, kuo, luo, suoma, ŝuo, muono ) GoTo 90 End If If M2 = "ii" Then If Not (H3 = "cii" Or H3 = "dii" Or H3 = "fii" Or H4 = "miit" Or H4 = ChrW(349) & "iit") Then GoTo 70 '(uitzondering: cii, dii/ [diigi, diino, diismo, diisto], fi/ [fiinsektoj, fiindustrio, ...], miito, ŝiit/ [ŝiito, ŝiitako] ) GoTo 90 End If 60: 'MsgBox "bij 60" GoTo 90 '----------- 70: CerteFremdlingva = True 'BEEP generation '[25-9-08] 'ipv standard VBA Beep wordt een sophisticated variant toegepast, met volgend stmt in de Declaration module: 'Private Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFrequency As Long, ByVal dwMilliseconds As Long) As Long 'bijv. BeepAPI 440, 500 bijv. betekent dan: frequency 440 Hertz, duration 500 milliseconds 'Patroon 1: For ibeepfreq = 300 To 600 Step 50 BeepAPI ibeepfreq, 14 Next ibeepfreq 'kort en snel omhoog 'Patroon 2: 'For ibeepfreq = 100 To 600 Step 20 ' BeepAPI ibeepfreq, 20 'Next ibeepfreq 'middelsnel eerst omhoog en dan weer omlaag gaande kraaktoon 'For ibeepfreq = 600 To 100 Step -20 ' BeepAPI ibeepfreq, 20 'Next ibeepfreq '[einde BEEP generation] 90: End Function Function SnijvlakBezemwagen(woord As String, nSnij As Integer, iSnij() As Integer) As Boolean 'ESPSOF Versio 0.8 5 Marto 2008 TW (Toon Witkam) 'bedoeld voor Esperanto (met UNICODE-Esperantoletters-geproduceerd-met-EK); 'dit macro is bedoeld voor het vaststellen van resterende potentiele snijvlakken in een woordsamenstelling, 'nadat snijvlakken vastgesteld door de meer sophisticated macros (SnijvlakKansBijO, SnijvlakImpossConsCluster, etc) 'geen succesvolle opsplitsing van een samengesteld woord hebben opgeleverd; 'dit SnijvlakBezemwagen-macro leent zich goed voor woorden waarbij klinkers en medeklinkers... '...elkaar bijna beurtelings afwisselen, dus woorden zonder enige consonantclusters; 'het macro is mede geinpspireerd door Klaus Schubert's DLT-werkstuk "Morphemanalyse fur IL und Esperanto" (23-5-1986); 'er wordt op gewezen dat, evenals bij de andere Snijvlakbepalings-macros, de volgorde waarin de Snijvlakken hieronder bepaald worden... '...NIET de volgorde is waarin later (door het macro VortKunmetoEkzist) de Snijvlakken via Dictionary-matches op realiseerbaarheid getest worden; 'er wordt van uitgegaan dat het in de functie ingevoerde woord wat betreft uitgang... '...GENORMALISEERD moet zijn (dus ALLEEN een -o, -a, e, -i uitgang, GEEN -on, -oj etc ) '[zie ook verderop in de functie-uitwerking] 'het macro kan achtereenvolgens van links naar rechts max. 30 Snijvlakken opsporen; 'van elk van deze opgespoorde Snijvlakken wordt de positie RECHTS van het SNIJVLAK (string-positie RECHTS van de O) teruggegeven via de Array-parameter iSnij; 'via de parameter nSnij wordt het AANTAL opgespoorde Snijvlakken teruggemeld. 'omdat dit macro bedoeld is voor onderzoek van taalwoordenlijsten, 'wordt er gekeken naar ALLEEN KLEINE LETTERS; hoofdletters worden NIET gezien! Dim WordLength As Integer Dim iChar As Integer Dim j As Integer Dim KlinkerLinks As Boolean SnijvlakBezemwagen = False 'er wordt vanuit gegaan dat er NIET zo'n Snijvlak in de string zit nSnij = 0 For j = 1 To 30 iSnij(j) = 0 'reset de integer Array-parameter iSnij (max. 30 waarden kunnen daarin worden teruggemeld) Next j j = 0 WordLength = Len(woord) If WordLength < 4 Then GoTo 99 ' 4 = minimale woordlengte voor samengesteld woord; '[30-10-06: van 6 op 4 gezet] KlinkerLinks = False 'Loop (van links naar rechts) door het woord: For iChar = 3 To WordLength - 2 'geen Snijvlak op eerste twee posities vanaf woordbegin... ' ...of op twee posities vanaf woorduitgang [uitgaande van GENORMALISEERDE uitgang op -o] If Not KlinkerLinks Then '[boolean KlinkerLinks voorkomt onnodig herhaald aanroepen van GeenKlinkerInString] 'Check in het begin of er al een klinker in het woord zit Links van het Snijvlak: If GeenKlinkerInString(Left(woord, iChar - 1)) Then GoTo 19 'op deze positie geen snijvlak mogelijk, probeer volgende letter-positie Else KlinkerLinks = True GoTo 21 End If Else 21: 'Check of er nog een klinker in het woord zit Rechts van het Snijvlak, ... 'afgezien van de 1-letter uitgang -o, -a, -e of -i (dan is bijv. "fantazidio" (fantazi-dio) nog net herkenbaar): If GeenKlinkerInString(Mid(woord, iChar, WordLength - iChar)) Then GoTo 29 'stop met zoeken naar nog verdere snijvlakken in dit woord End If 'Snijvlakkans (let wel: "KANS") wordt toegewezen: SnijvlakBezemwagen = True 'en de letter-positie (links waarvan van het Snijvlak ligt) wordt teruggegeven: For j = 1 To 30 If iSnij(j) = 0 Then iSnij(j) = iChar: GoTo 19 Next j MsgBox "Meer dan 30 O-Snijvlakken aangetroffen, in woord = " & woord End If 19: Next iChar 29: If iSnij(30) > 0 Then nSnij = 30 Else nSnij = j '3e parameter van Function, meldt AANTAL Snijvlakken terug; '(bij een woordstam zonder twee klinkers is er geen snijvlak gevonden, en blijft SnijvlakBezemwagen = False ) 99: End Function Function GeenKlinkerInString(woord As String) As Boolean 'ESPSOF Versio 0.8 5 Marto 2008 TW (Toon Witkam) 'Geldt voor talen met alleen de vijf accentloze klinkers a, e, i, o, u (of daarmee gevormde diphtongen au, ei, etc), en... '...ook voor Esperanto, waarbij de ŭ als klinker wordt beschouwd (ook als die niet in combinaties zoals aŭ, eŭ voorkomt); 'geldt NIET voor geaccentueerde letters in het Frans, Duits of andere talen! 'omdat dit macro bedoeld is voor onderzoek van taalwoordenlijsten, 'wordt er gekeken naar ALLEEN KLEINE LETTERS; klinkers die hoofdletter zijn worden NIET gezien! Dim iChar As Integer Dim k As Integer Dim WordLength As Integer GeenKlinkerInString = False 'er wordt vanuit gegaan dat er WEL een klinker in de string zit WordLength = Len(woord) For iChar = 1 To WordLength k = AscW(Mid(woord, iChar, 1)) If k = 97 Or k = 101 Or k = 105 Or k = 111 Or k = 117 Or k = 365 Then GoTo 9 ' a, e, i, o, u Next iChar GeenKlinkerInString = True 9: End Function Function OnmogelijkWoordBegin(woord As String) As Boolean 'ESPSOF Versio 0.8 5 Marto 2008 TW (Toon Witkam) 'van een gegeven woord wordt onderzocht of het BEGIN van dat woord een ONMOGELIJK is voor een Esperanto-woord: 'uitkomst 'true' betekent: "er is met zekerheid vastgesteld dat dit qua woordbegin GEEN Esperanto-woord is" 'uitkomst 'false' betekent: "er is NIET met zekerheid vastgesteld dat dit qua woordbegin GEEN Esperanto-woord is" 'bij dit macro wordt ervan uitgegaan, dat het invoerwoord als RECHTERDEEL van een GROTER WOORD reeds ... ' .... gecheckt is door macro CerteFremdLingva; 'verder is er zoveel mogelijk gelet op snelheid, en bespaard op controles (zoals bijv. op lege-string als invoerwoord, hoofdletters e.d.); 'terwijl het macro 'CerteFremdLingva' was toegesneden op de mogelijke aanwezigheid van 'anderstalige citaten en eigennamen in een tekst, wordt dit macro 'OnmogelijkWoordBegin' alleen gebruikt bij Recursie in het 'inwendige van KunmetAnaliz, om nodeloze Dictionary-searches uit te sparen; het gaat daarbij om DeelWoorden te vinden 'in (lange) Kunmetoj, waarbij ook een kans op foutgeschreven woorden aanwezig is; het aantal lettercombinaties waarmee 'een willekeurig woorddeel begint, maar waarmee nooit een echt Esp. woord kan beginnen, is veel en veel groter dan wat 'relevant was voor 'CerteFremdlingva'; we volgen daarom hier een andere aanpak: 'we gaan uit van de 35 mogelijke consonantparen aan woordbegin op grond van 22530 Nouns in Schuetz -Vortaro 2004 Dim i As Integer Dim Word As String Dim H2 As String Dim H3 As String Dim H4 As String Dim H5 As String Dim H6 As String Static ConsPaarBegin(40) As String Static ConsTrioBegin(10) As String Static iCall As Integer iCall = iCall + 1 'iCall bewerkt dat onderstaande 35 + 8 array-toewijzingen alleen de 1e keer plaatsvinden tijdens het gebruik van de macro-module If iCall > 1 Then GoTo 1 'Lijst van 35 mogelijke consonantparen aan woord-BEGIN (volgens Schuetz 22530 Noun-lijst); 'de lijst is geordend volgens afnemende frequentie van consonantparen: ConsPaarBegin(1) = "pr" ConsPaarBegin(2) = "tr" ConsPaarBegin(3) = "st" ConsPaarBegin(4) = "pl" ConsPaarBegin(5) = "kr" ConsPaarBegin(6) = "sp" ConsPaarBegin(7) = "fr" ConsPaarBegin(8) = "br" ConsPaarBegin(9) = "gr" ConsPaarBegin(10) = "sk" ConsPaarBegin(11) = "fl" ConsPaarBegin(12) = "gl" ConsPaarBegin(13) = "kl" ConsPaarBegin(14) = "dr" ConsPaarBegin(15) = "kv" ConsPaarBegin(16) = ChrW(349) & "t" ' "ŝt" ConsPaarBegin(17) = "bl" ConsPaarBegin(18) = ChrW(349) & "p" ' "ŝp" ConsPaarBegin(19) = "ps" ConsPaarBegin(20) = "sv" ConsPaarBegin(21) = "gv" ConsPaarBegin(22) = "sc" ConsPaarBegin(23) = "sl" ConsPaarBegin(24) = ChrW(349) & "l" ' "ŝl" ConsPaarBegin(25) = ChrW(349) & "r" ' "ŝr" ConsPaarBegin(26) = "pn" ConsPaarBegin(27) = ChrW(349) & "v" ' "ŝv" ConsPaarBegin(28) = "kn" ConsPaarBegin(29) = ChrW(349) & "n" ' "ŝn" ConsPaarBegin(30) = "gn" ConsPaarBegin(31) = "ks" ConsPaarBegin(32) = "sf" ConsPaarBegin(33) = "sm" ConsPaarBegin(34) = ChrW(349) & "m" ' "ŝm" ConsPaarBegin(35) = "ft" 'Lijst van 8 mogelijke consonant-trio's aan woord-BEGIN (volgens Schuetz 22530 Noun-lijst); 'de lijst is geordend volgens afnemende frequentie van consonant-trio's: ConsTrioBegin(1) = "str" ConsTrioBegin(2) = "skr" ConsTrioBegin(3) = "spr" ConsTrioBegin(4) = ChrW(349) & "pr" ' "ŝpr" ConsTrioBegin(5) = "skl" ConsTrioBegin(6) = "spl" ConsTrioBegin(7) = ChrW(349) & "tr" ' "ŝtr" ConsTrioBegin(8) = "skv" 1: OnmogelijkWoordBegin = False Word = woord H2 = Left(Word, 2) H3 = Left(Word, 3) H5 = Left(Word, 5) 'Check eerst of het woord met twee consonanten begint: If GeenKlinkerInString(H2) Then 'Woord begint met twee consonanten; check of dit consonantenpaar aan woordbegin mogelijk is: For i = 1 To 35 '(lijst is in volgorde van meest waarschijnlijke consonantenparen aan woordbegin) If H2 = ConsPaarBegin(i) Then GoTo 20 'OK, dit consonantenpaar is mogelijk Next i Else 'woord begint niet met twee consonanten GoTo 30 End If 'Onmogelijk consonantenpaar: If H5 = "ghett" Then GoTo 30 'uitzonderingen: "ghetto" GoTo 70 'OnmogelijkWoordBegin = True 20: 'Check nu nog even op evt. derde consonant: If GeenKlinkerInString(Right(H3, 1)) Then 'IWoord begint met drie consonanten; check of dit consonantentrio aan woordbegin mogelijk is: For i = 1 To 8 If H3 = ConsTrioBegin(i) Then GoTo 30 'OK, dit consonantentrio is mogelijk Next i Else 'woord begint niet met drie consonanten GoTo 30 End If 'Onmogelijk consonantentrio: 'If H5= "....." Then GoTo 30 'uitzonderingen: "......" GoTo 70 'OnmogelijkWoordBegin = True 30: 'Een Esp-woord kan niet met twee gelijke klinkers ( aa-, ee-, ii-, oo-, uu- ) beginnen: If Left(H2, 1) = Right(H2, 1) Then If Not H2 = "oo" Then GoTo 70 If Not (H5 = "oolit" Or H5 = "oomik" Or H5 = "oosfe" Or H5 = "oospo" Or H5 = "ootos") Then GoTo 70 GoTo 90 '(uitzonderingen: oolito, oomikotoj, oosfero, oosporo, ootosalpingo ) End If H4 = Left(Word, 4) H6 = Left(Word, 6) 'Vocaal-bigrammen die nooit aan de voorkant van een Esp-woord voor kunnen komen: ' eu, ei, oi, au, ua, ui, uo (uitzonderingsloos): If H2 = "eu" Or H2 = "ei" Or H2 = "oi" Or H2 = "au" Or H2 = "ua" Or H2 = "ui" Or H2 = "uo" Then GoTo 70 If (H2 = "ea" And Not (H4 = "east")) Then GoTo 70 '(uitz.: easto ) If (H2 = "oa" And Not (H3 = "oaz")) Then GoTo 70 '(uitz.: oazo ) If (H2 = "oe" And Not (H4 = "oero" Or H5 = "oestr")) Then GoTo 70 '(uitz.: oero, oestro ) If (H2 = "ou" And Not (H3 = "ouz")) Then GoTo 70 '(uitz.: ouzo ) If (H2 = "ae" And Not (H3 = "aed" Or H3 = "aer")) Then GoTo 70 '(uitz.: aedo, aero ) If (H2 = "ai" And Not (H5 = "aides" Or H5 = "aidos" Or H5 = "aikid" Or H4 = "aino" Or H4 = "airo" Or H5 = "aizoo" Or _ H6 = "aizoac" Or H6 = "ailant")) Then GoTo 70 '(uitzondering: aideso, aidoso, aikido, ailanto aino, airo, aizoo, aizoaco ) If (H2 = "ao" And Not (H4 = "aort")) Then GoTo 70 '(uitz.: aorto ) If (H2 = "ue" And Not (H3 = "ued" Or H4 = "uest")) Then GoTo 70 '(uitz.: uedo, uesto ) 'Alle hordes genomen (maar er is GEEN zekerheid dat het woordbegin mogelijk is ! ) GoTo 90 70: OnmogelijkWoordBegin = True '(er is ZEKERHEID dat het woordbegin onmogelijk is) 90: End Function Function OnmogelijkWoordOfStamEinde(woord As String) As Boolean 'ESPSOF Versio 0.8 5 Marto 2008 TW (Toon Witkam) 'van een gegeven woord wordt onderzocht of het WOORD- of STAM-EINDE daarvan ONMOGELIJK is voor een Esperanto-woord: 'uitkomst 'true' betekent: "er is met zekerheid vastgesteld dat dit qua einde GEEN Esperanto-woord is" 'uitkomst 'false' betekent: "er is NIET met zekerheid vastgesteld dat dit qua einde GEEN Esperanto-woord is" 'bij dit macro wordt ervan uitgegaan, dat het invoerwoord als LINKERDEEL van een GROTER WOORD reeds ... ' .... gecheckt is door macro CerteFremdLingva; 'verder is er zoveel mogelijk gelet op snelheid, en bespaard op controles (zoals bijv. op lege-string als invoerwoord, hoofdletters e.d.) 'terwijl het macro 'CerteFremdLingva' was toegesneden op de mogelijke aanwezigheid van 'anderstalige citaten en eigennamen in een tekst, wordt dit macro 'OnmogelijkStamEinde' alleen gebruikt bij Recursie in het 'inwendige van KunmetAnaliz, om nodeloze DICT-searches uit te sparen; het gaat daarbij om DeelWoorden te vinden 'in (lange) Kunmetoj, waarbij ook een kans op foutgeschreven woorden aanwezig is; het aantal lettercombinaties waarmee 'een willekeurig woorddeel eindigt, maar waarop nooit de stam van een echt Esp. woord kan eindigen, is veel en veel groter 'dan wat relevant was voor 'CerteFremdlingva'; we volgen daarom hier een andere aanpak: 'we gaan uit van de 43 mogelijke consonantparen aan STAM-einde op grond van 22530 Nouns in Schuetz -Vortaro 2004 Dim i As Integer Dim Word As String Dim T1 As String Dim T2 As String Dim T3 As String Dim T4 As String Dim T5 As String Dim Stam As String Static ConsPaarEind(90) As String Static ConsTrioEind(25) As String Static iCall As Integer iCall = iCall + 1 'iCall bewerkt dat onderstaande 79 + 20 array-toewijzingen alleen de 1e keer plaatsvinden tijdens het gebruik van de macro-module If iCall > 1 Then GoTo 1 'Lijst van 79 mogelijke consonantparen aan STAM-einde (volgens Schuetz 22530 Noun-lijst); 'de lijst is geordend volgens afnemende frequentie van consonantparen: ConsPaarEind(1) = "st" ConsPaarEind(2) = "nt" ConsPaarEind(3) = "tr" ConsPaarEind(4) = "sm" ConsPaarEind(5) = "nd" ConsPaarEind(6) = "kt" ConsPaarEind(7) = "nc" ConsPaarEind(8) = "ng" ConsPaarEind(9) = "rd" ConsPaarEind(10) = "rt" ConsPaarEind(11) = "rb" ConsPaarEind(12) = "ks" ConsPaarEind(13) = "bl" ConsPaarEind(14) = "sk" ConsPaarEind(15) = "br" ConsPaarEind(16) = "dr" ConsPaarEind(17) = "lt" ConsPaarEind(18) = "rn" ConsPaarEind(19) = "rk" ConsPaarEind(20) = "nk" ConsPaarEind(21) = "kl" ConsPaarEind(22) = "rm" ConsPaarEind(23) = "mp" ConsPaarEind(24) = "gn" ConsPaarEind(25) = "rs" ConsPaarEind(26) = "n" & ChrW(285) ' "ng" ConsPaarEind(27) = "mb" ConsPaarEind(28) = "jl" ConsPaarEind(29) = "pt" ConsPaarEind(30) = "ns" ConsPaarEind(31) = "ld" ConsPaarEind(32) = "lm" ConsPaarEind(33) = "ps" ConsPaarEind(34) = "gr" ConsPaarEind(35) = "jn" ConsPaarEind(36) = "lk" ConsPaarEind(37) = "kv" ConsPaarEind(38) = "rg" ConsPaarEind(39) = "n" & ChrW(265) ' "nc" ConsPaarEind(40) = "r" & ChrW(285) ' "rg" ConsPaarEind(41) = "rp" ConsPaarEind(42) = "rv" ConsPaarEind(43) = "pl" ConsPaarEind(44) = "jt" ConsPaarEind(45) = "gl" ConsPaarEind(46) = "kr" ConsPaarEind(47) = "rc" ConsPaarEind(48) = "ft" ConsPaarEind(49) = "lp" ConsPaarEind(50) = "pr" ConsPaarEind(51) = "gv" ConsPaarEind(52) = "lv" ConsPaarEind(53) = "gm" ConsPaarEind(54) = "lf" ConsPaarEind(55) = "r" & ChrW(265) ' "rc" ConsPaarEind(56) = "r" & ChrW(265) ' "rs" ConsPaarEind(57) = "vr" ConsPaarEind(58) = "jr" ConsPaarEind(59) = "nj" ConsPaarEind(60) = "lg" ConsPaarEind(61) = ChrW(349) & "t" ' "st" ConsPaarEind(62) = "tm" ConsPaarEind(63) = "fr" ConsPaarEind(64) = "ms" ConsPaarEind(65) = "rl" ConsPaarEind(66) = "mn" ConsPaarEind(67) = "nz" ConsPaarEind(68) = "ls" ConsPaarEind(69) = "nr" ConsPaarEind(70) = "jd" ConsPaarEind(71) = "js" ConsPaarEind(72) = "rf" ConsPaarEind(73) = "dl" ConsPaarEind(74) = "dz" ConsPaarEind(75) = "mf" ConsPaarEind(76) = "sp" ConsPaarEind(77) = "tt" ConsPaarEind(78) = "fl" ConsPaarEind(79) = "kc" 'Lijst van 20 mogelijke consonant-trio's aan STAM-einde (volgens Schuetz 22530 Noun-lijst); 'de lijst is geordend volgens afnemende frequentie van consonant-trio's: ConsTrioEind(1) = "str" ConsTrioEind(2) = "mbr" ConsTrioEind(3) = "ndr" ConsTrioEind(4) = "ntr" ConsTrioEind(5) = "nkt" ConsTrioEind(6) = "ngv" ConsTrioEind(7) = "ktr" ConsTrioEind(8) = "mpl" ConsTrioEind(9) = "kst" ConsTrioEind(10) = "nkr" ConsTrioEind(11) = "mbl" ConsTrioEind(12) = "ngr" ConsTrioEind(13) = "nkl" ConsTrioEind(14) = "ngl" ConsTrioEind(15) = "rkl" ConsTrioEind(16) = "rst" ConsTrioEind(17) = "skl" ConsTrioEind(18) = "rtr" ConsTrioEind(19) = "ptr" ConsTrioEind(20) = "stm" 1: OnmogelijkWoordOfStamEinde = False Word = woord T1 = Right(Word, 1) If T1 <> "o" Then MsgBox "FOUT: Function OnmogelijkWoordOfStamEinde" & vbCr & _ "is door KunmetAnaliz opgeroepen ZONDER -o uitgang" Word = Left(Word, Len(Word) - 1) 'o-uitgang wordt van het woord afgesneden T2 = Right(Word, 2) T3 = Right(Word, 3) T4 = Right(Word, 4) T5 = Right(Word, 5) 'Kijk of de STAM op 2 consonanten eindigt: If GeenKlinkerInString(T2) Then 'STAM eindigt op 2 consonanten: 'Stam eindigt op twee consonanten; check of dit consonantenpaar aan Stam-eind mogelijk is: For i = 1 To 79 '(lijst is in volgorde van meest waarschijnlijke consonantenparen aan Stam-eind) If T2 = ConsPaarEind(i) Then GoTo 20 'OK, dit consonantenpaar is mogelijk Next i Else 'Woord eindigt niet op twee consonanten GoTo 30 End If If T5 = "brahm" Or T4 = "fosf" Or T4 = ChrW(349) & "akd" Or T4 = "tenn" Then GoTo 20 'uitzonderingen: "brahmoo", "fosfoo", "ŝakdoo", "tennoo" 'Onmogelijk consonantenpaar: GoTo 70 'OnmogelijkWoordOfStamEinde = True 20: 'Check nu nog even op evt. derde consonant: If GeenKlinkerInString(Left(T3, 1)) Then 'IStam eindigt op drie consonanten; check of dit consonantentrio aan STAM-eind mogelijk is: For i = 1 To 20 If T3 = ConsTrioEind(i) Then GoTo 30 'OK, dit consonantentrio is mogelijk Next i Else 'woord begint niet met drie consonanten GoTo 30 End If If T5 = "maltr" Then GoTo 30 'uitzondering: "maltroo" 'Onmogelijk consonantentrio: GoTo 70 'OnmogelijkWoordOfStamEinde = True 30: 'Alle hordes genomen (maar er is GEEN zekerheid dat het Woord- of Stam-Einde mogelijk is ! ) GoTo 90 70: OnmogelijkWoordOfStamEinde = True '(er is ZEKERHEID dat het Woord- of Stam-Einde onmogelijk is) 90: End Function Function MatchEspWordToDict(woord As String, NameOfDictionary As String, _ struct As String, synmark As Integer, genvoc As Integer, ExtraMark As String) As Boolean 'ESPSOF Versio 0.94 17 oktobro 2008 TW (Toon Witkam) 'wordt opgeroepen door: TekstVortKontrol, KunmetAnaliz 'vervangt de vroegere versie: 'Function MatchEnkelEspWordToDictionaryVza6test(woord As String, NameOfDictionary As String) As Boolean 'Test of een gegeven woord voorkomt in een bepaald Esp.-Dictionary (FunctieWoordenLijst, BRO, PIV, DICT3) of Esp.-EigennamenBoek; 'bij testen op een van de Dictionaries mogen in het invoerwoord GEEN HOOFDLETTERS voorkomen '(noch gewone, noch diakritische hoofdletters). Indien er toch hoofdletters in voorkomen, 'zijn de uitkomsten van dit macro onbetrouwbaar ! 'bij testen op EigennamenBoek moet het invoerwoord beginnen met een Hoofdletter. 'Het invoerwoord moet met grammaticale uitgang -o, -a, -e, -en, -i, dus als Hoofdvorm (of met -en) worden aangeboden; 'andere uitgangen, woorden met ontbrekende uitgang, functiewoorden, vreemde woorden etc. zijn NIET toegestaan, 'tenzij aangeboden met de hoofdletter 'S' als Speciale Parameter aan het eind van het invoerwoord (ipv grammaticale uitgang -o,-a,-e,-en,-i). 'De beperking tot bepaalde grammaticale uitgangen vervalt ook bij aanroepen van het Esp.-Dictionary 'FunctieWoordenLijst' [23-11-05]. ' 'Er zijn vrijwel geen beperkingen voor de lengtes van de dictionaries. De lengte kan in 'de tienduizenden lopen, maar ook een klein dictionary is mogelijk. ' 'Deze macro is speciaal voor Esperanto gemaakt, en kan niet gebruikt worden voor talen met andere Unicode-tekens '(wel door talen met alleen de basis-Ascii letters t/m code 122). ' 'Een stringente voorwaarde is dat het Dictionary strikt moet zijn VOORGESORTEERD ... '... volgens de ESPERANTO-DICTIONARY SORTERING: 'bijv.: alle woorden beginnend met ĉ (c met supersigno) komen NA alle woorden beginnend met c (c zonder supersigno); 'deze sortering is anders dan de standaard Excel-sortering ! 'Het macro bevat hiervoor een binair (Tanenbaum) zoekalgoritme, dat als volgt is aangepast om te kunnen heenbreken door Excel: 'indien bij de 'groter-dan' of 'kleiner-dan' vergelijkingen zoekwoord en woordenboekwoord op dezelfde letterposities... '...tegengestelde sorterings-kritische letters (c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ ) bevatten, dan worden de diakritische letters tijdelijk... '...(gedurende enkele microseconden) vervangen. 'Het Dictionary moet dus strikt gesorteerd zijn volgens de Esperanto-DICTIONARY-sortering. 'Verder mogen er in het Dictionary geen twee dezelfde entries voorkomen. 'Evenmin mogen er lege entries in het Dictionary voorkomen. 'Het te testen woord en ook al de woorden in het Dictionary moeten links en rechts getrimd zijn van eventuele spaties. Dim key As String Dim dictword As String Dim keynh As String Dim low As Long Dim high As Long Dim middle As Long Dim Match As Long Dim ParamS As Boolean Dim uitgang As String Dim ENuitgang As Boolean Dim i1Dict As Integer Dim nDict As Integer Dim IendDict As Integer Dim EsperantoDictionaries As Object Dim ExtraTestUitvoer As Object Dim KritCharPos(2, 25) As Integer Dim iKritChar As Integer Dim nKritChar As Integer Dim iChar As Integer Dim k As Integer Dim Nulvector As Boolean Dim LenWoord As Integer Dim KorG As Integer Dim matchBinary As Boolean Dim iWorksheet As Integer Dim DictKolom As Integer Dim DictKolomExtraKode As Integer Dim HeaderDictKolom As String Dim iXtest As Integer Dim iXtestregel As Integer Dim nBinary As Integer Dim MetEigennaamBezig As Boolean 'Dim BROonlyKunmet As Boolean 'PRIVATE variable [21-8-08] Static iWarning As Integer 'If Not BROonly Then ExtraMark = "" '[18-8-08] 'BROonlyKunmet = False '[21-8-08] 'Check de hier als geldend gehanteerde invoerwoord-uitgang voor het matchen met de Esp-Dictionaries en het EigennaamBoek: 'Eigennaam-Compendium: '[28-1-2008] If NameOfDictionary = "EigennaamBoek" Then MetEigennaamBezig = True If Not Hoofdletter(Left(woord, 1)) Then MsgBox "Erarkodo 85001" 'alleen woorden die met Hoofdletter beginnen zijn hier toegestaan 'GoTo... 10001 'maar eerst nog even langs controleblok: "nDict in KolomHeader..." iWorksheet = 6 'Worksheet 6 van "2 Supersnelle Dicts" bevat EigennnaamBoek DictKolom = 3 'DictKolom = kolomnummer van de Eigennamen in het EigennnaamBoek key = woord 'zoekwoord uitgang = "" GoTo 2 End If 'BRO, PIV, DICT3 en Exceptions-oo/ao/eo/a-prefix/e-prefix: If NameOfDictionary <> "FunctieWoordenLijst" Then If (Not (Right(woord, 1) = "o" Or Right(woord, 1) = "a" Or Right(woord, 1) = "e" _ Or Right(woord, 2) = "en" Or Right(woord, 1) = "i" Or Right(woord, 1) = "S")) Then MsgBox "woord voor Dictionary search" & vbCr & "heeft geen uitgang -o, -a, -e, -en, -i of 'S' als Speciale Parameter" '(NIET toegestaan zijn woorden op -oj, -on etc, woordstammen, functiewoorden, vreemde woorden etc.) GoTo 990 End If End If 2: 'Doorschakelen naar het juiste Dictionary (FunctieWoordenLijst, BRO, PIV, DICT3, ...): Set EsperantoDictionaries = GetObject(EspsofVORTAR) LenWoord = Len(woord) If MetEigennaamBezig Then GoTo 80 'If NameOfDictionary = "BROonlyK" Then '[21-8-08] ' BROonlyKunmet = True ' NameOfDictionary = "BRO" 'End If If NameOfDictionary = "FunctieWoordenLijst" Then iWorksheet = 1 DictKolom = 6 'DictKolom = nummer van de woordenkolom van het "FunctieWoordenLijst" Dictionary DictKolomExtraKode = 5 ' = VortSpeco-kode (speciaal voor Functiewoorden ivm EspTekstAnalizilo) key = woord 'zoekwoord uitgang = "" '[23-10-06] ElseIf NameOfDictionary = "BRO" Then If LenWoord > 12 Then GoTo 990 'max. lengte van BRO-radiko = 11, dus 12 voor woord met uitgang -o, -a, -e, -i; voor BRO-woord op -en is max. lengte ook 12 [12-10-08] iWorksheet = 2 'WorkSheet2 bevat BRO (Baza Radikaro Oficiala) DictKolom = 3 'DictKolom = nummer van de woordenkolom van het BRO Dictionary 'BROwoord = True '[*11-2-2007 verwijderd; deze boolean had geen zin meer] GoTo 22: '[14-10-08] If Not BROonly Then If Right(woord, 2) <> "en" Then key = Left(woord, LenWoord - 1) 'zoekwoord, bij BRO (Radikaro!) is dat ZONDER de uitgang -o, -a, -e, of -i ... uitgang = Right(woord, 1) 'uitgang -o, -a, -e, of -i bewaren voor toevoeging in Struct '[23-10-06] Else '[*de speciale parameter 'S' aan het eind van het invoerwoord heeft bij BRO geen extra betekenis] ENuitgang = True key = Left(woord, LenWoord - 2) '...resp. ZONDER de uitgang -en (denk aan bijvoorbeeld "hejm-en" ) 'MsgBox "uitgang '-en' aangetroffen in BRO-tak van macro 'MatchEspWordToDict' " '* Msgbox achtergelaten op 15-10-2005 '[27-9-08]: in nieuwe versie van na 25-9-08 bleek bovenstaande ELSE stmt prima te functioneren; de MsgBox en onderstaand commentaar kan dus weggehaald worden! '***bovenstaande MsgBox is sinds 2005 nooit meer aangetroffen; mocht dit toch nog gebeuren, of mochten woorden op -en anderszins ... '...fout verwerkt worden, dan bovenstaande "en"-If-Else ook kopieren (integreren) in onderstaande "If BROonly" ***[15-8-08] End If Else 'If BROonly: '[15-8-08] 'If Not ((Right(woord, 2) = "ia" Or woord = ChrW(265) & "io" Or woord = "pro" Or woord = "tro" Or woord = "pra" Or woord = "tra") Or _ ' (LenWoord = 2 And Not (woord = "fe" Or woord = "te"))) Then 22: If ExtraMark <> "2" Then '(bij BROonly heeft ExtraMark de betekenis van NurAfAuMem) '[18-8-08] If Right(woord, 2) <> "en" Then If Right(woord, 2) = "oo" And woord <> "heroo" Then GoTo 790 '[13-10-08, ter uitsluiting van "pro-o-kaze" e.d.] '[14-10-08: goto 990 veranderd in goto 790 !] 'If Right(woord, 2) = "eo" And ExtraMark <> "eo" Then GoTo 990 '[13-10-08, ter uitsluiting van "ĉe-o-kaza" e.d.] key = Left(woord, LenWoord - 1) 'zoekwoord, bij BRO (Radikaro!) is dat ZONDER de uitgang -o, -a, -e, of -i ... uitgang = Right(woord, 1) 'uitgang -o, -a, -e, of -i bewaren voor toevoeging in Struct '[23-10-06] Else 'woord op -en '[26-8-08]: ENuitgang = True key = woord 'zoekwoord (inclusief uitgang -en, bijv. "hejmen") '[23-9-08] uitgang = "en" 'uitgang -en bewaren voor toevoeging in Struct '[26-8-08] DictKolom = 8 'adverbs op -en kolom H (in BRO-sheet) '[26-8-08] End If Else 'If NurAfAuMem = "2": 'bij de 25 affix-achtige woorddelen: mia, via, lia, ŝia, ĝia, nia, ilia, sia, onia, kia, tia, ia, ĉia, nenia, ... key = woord '[15-8-08] ' .... ĉe, de, ge, ne, re, bo, po, pro, tro, pra, tra '[15-8-08] uitgang = "" '[15-8-08] End If End If ElseIf NameOfDictionary = "PIV" Or NameOfDictionary = "DICT3" Then If NameOfDictionary = "PIV" Then iWorksheet = 3 Else iWorksheet = 4 'WorkSheet3 bevat PIV, WorkSheet4 bevat DICT3 If BROonly Or (TutaPIV And iWorksheet = 4) Then '1-8-08: bij deze GebruikersOpties worden PIV resp. Dict3 genegeerd: MatchEspWordToDict = False 'result van Function MatchEspWordToDict genvoc = 0 GoTo 990 End If 'eind 1-8-08 'DictKolom = nummer van de woordenkolom van PIV / DICT3 Dictionary If Right(woord, 1) = "o" Then key = woord 'zoekwoord uitgang = "o" 'uitgang -o bewaren voor toevoeging in Struct '[23-10-06] DictKolom = 3 'nouns op -o kolom C ElseIf Right(woord, 1) = "S" Then ParamS = True key = Left(woord, LenWoord - 1) 'zoekwoord DictKolom = 19 'stammen van niet-nouns (adjectieven, verbs, adverbs) kolom S [* de speciale parameter 'S' ] ElseIf Right(woord, 1) = "a" Then key = woord 'zoekwoord uitgang = "a" 'uitgang -a bewaren voor toevoeging in Struct '[23-10-06] DictKolom = 7 'adjectives op -a kolom G ElseIf Right(woord, 1) = "e" Then key = woord 'zoekwoord uitgang = "e" 'uitgang -e bewaren voor toevoeging in Struct '[23-10-06] DictKolom = 11 'adverbs op -e kolom K ElseIf Right(woord, 2) = "en" Then ENuitgang = True key = woord 'zoekwoord uitgang = "en" 'uitgang -en bewaren voor toevoeging in Struct '[23-10-06] DictKolom = 23 'adverbs op -en kolom W '28-9-06 [voorheen stonden adverbs op -en in kolom L ] 'MsgBox "uitgang -en aangetroffen in PIV/DICT3-tak van macro 'MatchEspWordToDict' " '* Msgbox gebruikt 15-10-2005 ElseIf Right(woord, 1) = "i" Then key = woord 'zoekwoord uitgang = "i" 'uitgang -i bewaren voor toevoeging in Struct '[23-10-06] DictKolom = 15 'verbs op -i kolom O End If 'EXCEPTION dictionaries (deze zijn ook toegankelijk bij BROonly [23-9-08] ): ElseIf Left(NameOfDictionary, 11) = "Exceptions-" Then iWorksheet = 5 If NameOfDictionary = "Exceptions-oo" Then If Right(woord, 1) = "o" Then key = woord 'zoekwoord If Right(key, 2) <> "oo" Then key = key & "o" '[5-11-2005] DictKolom = 3 'nouns op -oo kolom C (exceptielijst voor nouns op -oo ) Else MsgBox "FOUT: invoer woord zonder o-uitgang, bij Exceptions-oo" '[*de speciale parameter 'S' mag niet gebruikt worden bij Dictionary = Exceptions-oo ] End If ElseIf NameOfDictionary = "Exceptions-ao" Then '[6-11-2005] If Right(woord, 1) = "a" Then key = woord & "o" 'zoekwoord DictKolom = 7 'nouns op -ao kolom G (exceptielijst voor nouns op -oo ) Else MsgBox "FOUT: invoer woord zonder a-uitgang, bij Exceptions-ao" '[*de speciale parameter 'S' mag niet gebruikt worden bij Dictionary = Exceptions-ao ] End If ElseIf NameOfDictionary = "Exceptions-eo" Then '[6-11-2005] If Right(woord, 1) = "e" Then key = woord & "o" 'zoekwoord DictKolom = 11 'nouns op -eo kolom K (exceptielijst voor nouns op -oo ) Else MsgBox "FOUT: invoer woord zonder e-uitgang, bij Exceptions-eo" '[*de speciale parameter 'S' mag niet gebruikt worden bij Dictionary = Exceptions-eo ] End If ElseIf NameOfDictionary = "Exceptions-a-prefix" Then '[6-11-2005] If Right(woord, 1) = "a" Then key = woord DictKolom = 15 '(pseudo)prefix op -a kolom O (exceptielijst voor nouns op -oo ) Else MsgBox "FOUT: invoer woord zonder a-uitgang, bij Exceptions-ao" '[*de speciale parameter 'S' mag niet gebruikt worden bij Dictionary = Exceptions-a-prefix ] End If ElseIf NameOfDictionary = "Exceptions-e-prefix" Then '[6-11-2005] If Right(woord, 1) = "e" Then key = woord DictKolom = 19 '(pseudo)prefix op -e kolom S (exceptielijst voor nouns op -oo ) Else MsgBox "FOUT: invoer woord zonder e-uitgang, bij Exceptions-eo" '[*de speciale parameter 'S' mag niet gebruikt worden bij Dictionary = Exceptions-e-prefix ] End If Else MsgBox "FOUT: onjuiste Exceptions-Dictionary -naam ingevoerd" & vbCr & vbCr & _ "moet zijn: " & vbCr & _ " 'Exceptions-oo', 'Exceptions-ao', 'Exceptions-eo'," & vbCr & _ " 'Exceptions-a-prefix' of 'Exceptions-e-prefix' " End If Else MsgBox "FOUT: onjuiste dictionary-naam ingevoerd" & vbCr & vbCr & _ "moet zijn: " & vbCr & _ " 'FunctieWoordenLijst', 'BRO', 'PIV', 'DICT3' ," & vbCr & _ " of 'Exceptions-....' " End If '---------------------------------------------------------------------------------- 80: 'Binnen de Worksheet van het betreffende Dictionary. With EsperantoDictionaries.worksheets(iWorksheet) i1Dict = 3 'beginpositie (rij) van de woorden van het Dictionary of EigennamenBoek HeaderDictKolom = .Cells(i1Dict - 1, DictKolom).Value 'header waarin staat: "2243 radikoj" of: "27752 nouns..." of: "473 Propraj Nomoj..." If Not MetEigennaamBezig Then HeaderDictKolom = Right(HeaderDictKolom, Len(HeaderDictKolom) - 18) '[ Header begint met de 18 tekens "Dictionary-sorted" & vbCr ] Else 'If MetEigennaamBezig Then: HeaderDictKolom = Right(HeaderDictKolom, Len(HeaderDictKolom) - 13) '[ Header begint met de 13 tekens "Excel-sorted" & vbCr ] End If nDict = Left(HeaderDictKolom, InStr(2, HeaderDictKolom, " ") - 1) 'Lengte van het Dictionary (aantal woorden bij 1 woord per rij) '*Extra controle op het juist 'pakken' van de in de Header aangegeven kolomlengte [voor FunctieWoordenLijst, BRO, PIV, DICT3, Exceptions]: If Not (nDict = 478 Or nDict = 2372 Or nDict = 48 _ Or nDict = 27793 Or nDict = 5592 Or nDict = 737 Or nDict = 6488 Or nDict = 11459 Or nDict = 68 _ Or nDict = 8776 Or nDict = 1771 Or nDict = 380 Or nDict = 380 Or nDict = 2437 Or nDict = 6 _ Or nDict = 47 Or nDict = 77 Or nDict = 377 Or nDict = 16 Or nDict = 7 _ Or nDict = 463) Then _ MsgBox "nDict in KolomHeader niet juist 'gepakt' !" IendDict = nDict + i1Dict - 1 'laatste positie (rij) van de woorden van het Dictionary If MetEigennaamBezig Then GoTo 10001 '*************************** 10000: 'Ingang voor Taalwoorden: '[28-1-2008] 'Beginwaarden: low = i1Dict ' i1Dict = Begin van het hele Dictionary high = IendDict ' IendDict = Einde van het hele Dictionary Match = 0 'key = zoekwoord '[geassigneerd hierboven, onder 'Schakelen naar het juiste Dictionary'] 'de key (het invoertekstwoord) zelf mag NIET veranderd worden, ook niet wat betreft hyphens! [6-12-05] keynh = HaalHyphensWeg(key) 'voor mede testen zonder hyphens '[8-7-08] nKritChar = 0 iKritChar = 1 For iChar = 1 To Len(key) 'Vector van (Dia-)Kritische Character-Posities wordt opgesteld: k = AscW(Mid(key, iChar, 1)) If k = 99 Then KritCharPos(2, iKritChar) = 265: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 103 Then: KritCharPos(2, iKritChar) = 285: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 104 Then: KritCharPos(2, iKritChar) = 293: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 106 Then: KritCharPos(2, iKritChar) = 309: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 115 Then: KritCharPos(2, iKritChar) = 349: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 117 Then: KritCharPos(2, iKritChar) = 365: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If If Not k > 122 Then GoTo 10 If k = 265 Then KritCharPos(2, iKritChar) = 99: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 285 Then: KritCharPos(2, iKritChar) = 103: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 293 Then: KritCharPos(2, iKritChar) = 104: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 309 Then: KritCharPos(2, iKritChar) = 106: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 349 Then: KritCharPos(2, iKritChar) = 115: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 ElseIf k = 365 Then: KritCharPos(2, iKritChar) = 117: KritCharPos(1, iKritChar) = iChar: iKritChar = iKritChar + 1 End If 10: '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) Next iChar nKritChar = iKritChar - 1 'nKritChar = aantal kritische characterposities in zoekwoord, namelijk die... '...waarop een 'kritisch character' staat: c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ; 'De Kritische-Character-Positie-Vector heeft nKritChar kolommen van elk 2 integerwaarden: 'de eerste geeft de letterpositie in het woord aan, 'de tweede geeft het Unicode-nummer van het Complementaire Teken aan (waarbij bijv. s complementair is met ŝ ) 'indien nKritChar=0 dan heeft het zoekwoord een 'Nulvector' (geen kritische tekens, bijv. 'tablo', 'prezidento', ...): If nKritChar = 0 Then Nulvector = True Else Nulvector = False 'MsgBox "Zoekwoord: I= " & I & " , key = " & key & vbCr & _ "nNulvector = " & Nulvector GoTo 100 '*************************** 10001: 'Ingang voor Eigennamen: '[28-1-2008] If Not MetEigennaamBezig Then MsgBox "Erarkodo 85002" 'Beginwaarden: low = i1Dict ' i1Dict = Begin van het hele EigennaamBoek high = IendDict ' IendDict = Einde van het hele EigennaamBoek Match = 0 'key = zoekwoord '[geassigneerd hierboven] keynh = HaalHyphensWeg(key) 'voor mede testen zonder hyphens '[8-7-08] nKritChar = 0 Nulvector = True 100: ' ------------------------------------------- Binary Search algorithme [see Tanenbaum, p. 305-307]: -------------------------------------------- 'If high = IendDict Then 'alleen msgbox bij begin van inzoomen 'If MsgBox("label 100; inzoomen, Binary Search)" & vbCr & _ "met: low = " & low & ", high = " & high, vbYesNo) = vbNo Then GoTo 990 'End If If low = high Then 'Zoekrange geheel ingezoomd: middle = low dictword = .Cells(middle, DictKolom).Value 'key = dictword ("nu-of-nooit" match!): If key = dictword Then GoTo 160 If keynh = dictword Then GoTo 160 'herkansing door weglating overbodige hyphen in het zoekwoord, bijv. bij "abel-manĝulo" [8-7-08] middle = middle - 1 'herkansing n.a.v. missers zoals ontdekt bij "s-ro", "k-do" en andere hyphenated woorden [8-7-08]: dictword = .Cells(middle, DictKolom).Value If key = dictword Then GoTo 160 If Not keynh = dictword Then GoTo 170 'herkansing door weglating overbodige hyphen in het zoekwoord, bijv. bij "abel-manĝulo" [8-7-08] 160: Match = middle low = middle 'wordt (in een reeks zoekprocessen met alfabetisch geordende zoekwoorden) ondergrens voor volgend zoekwoord 'MsgBox "match! Dict-index = " & Match & ", en " & low & " wordt de nieuwe beginwaarde voor volgend zoekwoord" GoTo 700 170: 'Else: 'If MsgBox("ingezoomde zoekrange: GEEN MATCH bij: middle = " & middle & " Doorgaan?", vbYesNo) = vbNo Then GoTo 990 'low = middle Match = 0 GoTo 700 ElseIf low < high Then middle = (low + high) / 2 'Deel zoekrange op in twee helften (afronding middenpositie soms naar boven soms naar beneden): dictword = .Cells(middle, DictKolom).Value If MetEigennaamBezig Then '[28-1-2008] 'het EigennaamBoek is opgebouwd volgens... KorG = StrComp(key, dictword, vbTextCompare) '...de GEWONE alfabetische SORTERING, dus niet volgens... 'KorG = StrComp(key, dictword, vbBinaryCompare) '...de speciale Esp-dict sortering GoTo 10258 '[28-1-2008] End If matchBinary = False If Not Nulvector Then 'Bij kritische letters (c, g, h, j, s, u, ĉ, ĝ, ĥ, ĵ, ŝ, ŭ ): Speciale voorbehandeling > en < vergelijking. LenWoord = Len(dictword) For iKritChar = 1 To nKritChar 'Vergelijking tussen Zoekwoord en Dictionary-woord: iChar = KritCharPos(1, iKritChar) If iChar > LenWoord Then Exit For If AscW(Mid(dictword, iChar, 1)) = KritCharPos(2, iKritChar) Then 'Eerste letterpositie (vanaf links) in beide woorden ontdekt met Tegengesteld Kritische letters ( c - ĉ , g - ĝ , ....); 'ExtraTestUitvoer.Worksheets(1).Cells(iXtestregel, 9).Value = iKritChar '***toegevoegd 3-9-2006*** 'Check of ook linkerwoorddelen daaraan voorafgaand gelijk zijn: If Left(key, iChar - 1) = Left(dictword, iChar - 1) Then matchBinary = True: Exit For End If Next iKritChar '(N.B.: Hoofdletters worden verondersteld NIET voor te komen!) End If 'MsgBox "key = |" & key & "|" & vbCr & vbCr & _ "dictword = |" & dictword & "|" 'test-instrumentatie 'Mix van vbText- en vbBinary-compare is nodig ivm ESP-DICT-SORTERING van woordlijst en dictionary: If Not matchBinary Then KorG = StrComp(key, dictword, vbTextCompare) 'N.B. Er mogen GEEN HOOFDLETTERS voorkomen in Dict of zoekwoorden ! Else 'If matchBinary Then 'MsgBox "Tegengesteld Kritische Teken(s) op zelfde letterpositie(s), bij I = " & I KorG = StrComp(key, dictword, vbBinaryCompare) 'ivm Tegengesteld Kritische Teken(s) op zelfde letterpositie(s) End If 10258: '[label toegevoegd 28-1-2008] 'If key < dictword Then 'key < dictword (zoek verder in onderhelft) If KorG = -1 Then 'MsgBox "<" high = middle - 1 'If high - low < 64 Then MsgBox "proceed < 64, in lower half" GoTo 100 'ElseIf key > dictword Then 'key > dictword (zoek verder in bovenhelft) ElseIf KorG = 1 Then 'MsgBox ">" low = middle + 1 'If high - low < 64 Then MsgBox "proceed < 64, in upper half" GoTo 100 Else 'If KorG = 0 Then 'key = dictword ("toevallige voortijdige" match!) 'MsgBox "=" low = middle If key = dictword Then GoTo 260 If Not keynh = dictword Then GoTo 270 'herkansing door weglating overbodige hyphen in het zoekwoord, bijv. bij "abel-manĝulo" [8-7-08] 260: Match = middle 'low = middle 'ondergrens voor volgend zoekwoord 'MsgBox "match! Dict-index = " & Match & ", en " & low & " wordt de nieuwe beginwaarde voor volgend zoekwoord" GoTo 700 270: 'Else: 'If MsgBox("verdacht geval van GEEN MATCH: middle = " & middle & " Doorgaan?", vbYesNo) = vbNo Then GoTo 990 '[de totnutoe bekende oorzaak is dat een taalwoord geheel in hoofdletters is geschreven, bijv. "EN", "HALO", "DECIDO", ... : 'zoekwoord en Dictionary-woord zijn dan volgens vbTextcompare gelijk, maar volgens het gewone =-teken niet] low = middle Match = 0 GoTo 700 End If Else If low > high + 1 Then If MsgBox("ERROR: low > high + 1" & vbCr & vbCr & _ "low = " & low & " , middle = " & middle & " , high = " & high & vbCr & vbCr & _ "Doorgaan? ", vbYesNo) = vbNo Then GoTo 990 End If low = high 'automatische correctie GoTo 100 End If 700: If low < i1Dict Then MsgBox "*** low < i1Dict [bij label 700]" '[***wschl kunnen onderstaande 2 stmts weg] 'If low < i1Dict Then low = i1Dict '(bescherming tegen onderschrijding door low=middle-5 mechanisme) 'If Zones Then high = IendZone Else high = IendDict 'Boekhouding: 'match = Long integer, die de dictionary-entry van het gematchte woord aangeeft; 'indien er geen match was (woord niet in dictionary) dan is match=0. If Match = 0 Then MatchEspWordToDict = False 'result van Function MatchEspWordToDict nNegativeDictSearches = nNegativeDictSearches + 1 genvoc = 0 ElseIf Match <= IendDict Then MatchEspWordToDict = True 'terugmelding resultaat van MatchEspWordToDict aan oproepende programma nPositiveDictSearches = nPositiveDictSearches + 1 If iWorksheet = 1 Then 'bij FUNCTIEWOORDEN: verzorg terugmelding VortSpeco-kode via 'woord'-parameter: woord = .Cells(middle, DictKolomExtraKode).Value 'MsgBox "Check: Vortspeco-kode = |" & woord & "|" & vbCr & vbCr & _ "(voor terugmelding vanuit MatchEspWordToDict)" End If If GenVoc16only Then 'bij deze GebruikersOptie (OpcioIII) worden woorden die geen GenVoc=16 hebben genegeerd [1-8-08]: If iWorksheet = 3 Then 'de controle op GenVoc16 is van toepassing op PIV (iWorksheet 3) If .Cells(Match, DictKolom + 3).Value <> 16 Then GoTo 790 'negeer dictionary Match ElseIf iWorksheet = 5 And (ExtraMark <> "EindCheckExcept") Then 'de controle op GenVoc16 is bovendien van toepassing op ... '... de Exceptionslijsten (iWorksheet 5), behalve wanneer die gebruikt worden om wegfiltering van ... '... -a-o en -e-o gevallen in de eindfase van KunmetAnaliz uit te sluiten ["EindCheckExcept"] If .Cells(Match, DictKolom + 3).Value <> 16 Then GoTo 790 'negeer dictionary Match End If End If '------------------[21-8-08]:------------------ If iWorksheet = 2 Then 'bij BRO: 'If Not BROonlyKunmet Then 'tenzij aangeroepen door KunmetAnaliz bij Opcio IV (BROonly): 'If BROonly And Not BROonlyKunmet Then 'tenzij aangeroepen door KunmetAnaliz bij Opcio IV (BROonly): '[14-10-08] If Not BROkunmetDeel Then 'tenzij aangeroepen door KunmetAnaliz (vanuit BRO-deel van Hoofdblok): '[14-10-08 nieuw] 'Bepaalde entries in VORTAR-BRO worden genegeerd bij ESPSOF-OpcioIII, -OpcioII en OpcioI, en ook bij OpcioIV indien het een LOSSTAAND tekstwoord betreft: If .Cells(Match, DictKolom + 4).Value = "1" Or _ .Cells(Match, DictKolom + 4).Value = "2" Then 'negeer dictionary Match bij NurAfOpcioIV=1 of NurAfOpcioIV=2 If woord <> "nea" And woord <> "neS" And woord <> "gea" Then GoTo 790 '[10-9-08] uitzonderingen "nea", "nee" [met S-parameter], "gea" ] End If End If 'Ter vermijding van toelating van functiewoord-derivaten als "dumo", "dumi", "dumas", "diso", "foro", "reo" etc.: '[30-8-08] '(geldt OOK voor Opcio I t/m III, omdat die OOK gebruik maken van BRO en de daarin verfijnde gebruiksspecificaties [ "0", "0+", "0-" ] voor functiewoord-derivaten) '[8-10-08]: 'If BROonly And Not BROonlyKunmet Then 'tenzij aangeroepen door KunmetAnaliz bij Opcio IV (BROonly): If Not BROkunmetDeel Then 'tenzij aangeroepen door KunmetAnaliz (vanuit BRO-deel van Hoofdblok): '[14-10-08 nieuw] 'Se envortara NurAfOpcioIV= "0" malpermesu substantivajn kaj verbajn formojn: If .Cells(Match, DictKolom + 4).Value = "0" And (uitgang = "o" Or uitgang = "i") Then GoTo 790 'negeer dictionary Match bij NurAfOpcioIV= "0" 'Se envortara NurAfOpcioIV= "0+" malpermesu substantivajn formojn, sed permesu verbajn kaj adverbajn: If .Cells(Match, DictKolom + 4).Value = "0+" And uitgang = "o" Then GoTo 790 'negeer dictionary Match bij NurAfOpcioIV= "0+" 'Se envortara NurAfOpcioIV= "0-" malpermesu substantivajn, verbajn kaj adverbajn formojn [21-9-08]: If .Cells(Match, DictKolom + 4).Value = "0-" And (uitgang = "e" Or uitgang = "o" Or uitgang = "i") Then GoTo 790 'negeer dictionary Match bij NurAfOpcioIV= "0-" End If If BROkunmetDeel Then 'if BROkunmetDeel: '[14-10-08 nieuw] If Right(key, 1) = "e" And uitgang = "o" And .Cells(Match, DictKolom + 4).Value <> "eo" Then GoTo 790 '[13-10-08, ter uitsluiting van "ĉe-o-kaza" e.d.] ExtraMark = .Cells(Match, DictKolom + 4).Value 'NurAfAuMem wordt via parameter ExtraMark teruggemeld naar oproepend macro [15-8-08] End If '[9-9-08] ivm "eo" End If '-------[21-8-08]------- GoTo 800 790: 'Woord AFGEKEURD, ondanks Match in BRO-lijst: MatchEspWordToDict = False 'result van Function MatchEspWordToDict nPositiveDictSearches = nPositiveDictSearches - 1 nNegativeDictSearches = nNegativeDictSearches + 1 genvoc = 0 GoTo 990 800: '----------------- 'Verwerking van de Struct-parameter: '[toegevoegd 5-10-06] 'Eerst verwerken als invoerparameter (evt. Struct toevoegen): 'If iWarning = 0 Then MsgBox "Attentie: Er worden Struct's GESCHREVEN in PIV-3-snelle-Dicts": iWarning = 1 'If Struct = "" Then MsgBox "FOUT: er wordt LEGE Struct geschreven in PIV-3-snelle-Dicts" 'er wordt niet gelezen, maar GESCHREVEN in het DICT '**[code VERWIJDEREN in stadium waarin NIET MEER GESCHREVEN wordt] [25-9-06] '.Cells(Match, DictKolom + 1).Value = Struct 'de Struct wordt geschreven 'Normaal gebruik (de Struct wordt gelezen): 'If BROwoord Then '[*11-2-2007: boolean BROwoord heeft geen zin meer, kan weg] struct = .Cells(Match, DictKolom + 1).Value '[<= BELANGRIJK, dit stmt laten staan! *11-2-2007] 'Else ' struct = .Cells(Match, DictKolom + 1).Value 'End If 'Evt. toevoeging uitgang "-en": '[11-2-2007] If ENuitgang Then struct = struct & uitgang & ChrW(MorDis) 'Bij ontbreken van morfeem-Struct in het Dictionary wordt de gewone woordstring gebruikt ['graceful degradation']: If struct = "" Then If ParamS Then struct = .Cells(Match, 19).Value & ChrW(MorDis) ' 19 = DictKolom "S" 'ElseIf MetEigennaamBezig Then 'verwijderd [30-1-2008]: 'struct = key '[28-1-2008] 'verwijderd [30-1-2008] (macro TekstVortKontrol zorgt hiervoor, bij Eigennamen) Else If Not ENuitgang Then struct = Left(key, Len(key) - 1) & ChrW(MorDis) Else 'If uitgang "-en": struct = Left(key, Len(key) - 2) & ChrW(MorDis) & uitgang & ChrW(MorDis) End If End If End If '----------------- If NameOfDictionary = "FunctieWoordenLijst" Then GoTo 990 '[4-10-08] '----------------- 'Verwerking van de SynMark-parameter: '[toegevoegd 29-9-06] 'Eerst verwerken als invoerparameter (indien deze een NEGATIEVE waarde, bijv. " -9 " heeft): 'If iWarning = 0 Then MsgBox "Attentie: Er worden Struct's GESCHREVEN in PIV-3-snelle-Dicts": iWarning = 1 'If SynMark < 0 Then 'er wordt niet gelezen, maar GESCHREVEN in het DICT '**[code VERWIJDEREN in stadium waarin NIET MEER GESCHREVEN wordt] [25-9-06] ' If DictKolom = 15 Or DictKolom = 19 Then '(alleen bij Dict-kolom voor -i -woorden en bij S-kolom) ' .Cells(Match, DictKolom + 2).Value = Abs(SynMark) 'de POSITIEVE waarde wordt geschreven... ' End If 'End If ' ...en weer als uitvoerparameter teruggemeld: 'Indien invoerparameter nul of positief, dan is het alleen een uitvoerparameter: synmark = .Cells(Match, DictKolom + 2).Value '(ook bij Eigennamen [28-1-08]) '----------------- 'Verwerking van de GenVoc-parameter: '[toegevoegd 24-9-06] 'Eerst verwerken als invoerparameter (indien deze een NEGATIEVE waarde, bijv. " -16 " heeft): 'If iWarning = 0 Then MsgBox "Attentie: Er worden Struct's GESCHREVEN in PIV-3-snelle-Dicts": iWarning = 1 'If GenVoc < 0 Then 'er wordt niet gelezen, maar GESCHREVEN in het DICT '**[code VERWIJDEREN in stadium waarin NIET MEER GESCHREVEN wordt] [25-9-06] ' If DictKolom = 3 Or DictKolom = 7 Or DictKolom = 11 Or DictKolom = 15 Or DictKolom = 19 Or DictKolom = 23 Then '(alleen bij Dict-kolommen voor -o, -a, -e, -i, -en -woorden en bij S-kolom) ' .Cells(Match, DictKolom + 3).Value = Abs(GenVoc) 'de POSITIEVE waarde wordt geschreven... ' End If 'End If ' ...en weer als uitvoerparameter teruggemeld: 'Indien invoerparameter nul of positief, dan is het alleen een uitvoerparameter: If NameOfDictionary <> "DICT3" Then genvoc = .Cells(Match, DictKolom + 3).Value '(ook bij BRO [29-9-08], ook bij "S"-kolom, ook bij Eigennamen [28-1-2008], maar NIET bij DICT3 [2-3-2008]) If iWorksheet = 6 Then ExtraMark = .Cells(Match, DictKolom + 4).Value '(alleen bij Eigennamen [20-2-08]) '----------------- Else If MsgBox("PROGRAMMA-FOUT: match-index outside range", vbYesNo) = vbNo Then GoTo 990 End If 990: 'Afsluiting: End With 999: End Function Function KunmetAnaliz(InvoerWoord As String, Splitsing() As String, nSplitsingen As Integer, iPosOptionalHyphen As Integer) As Boolean 'ESPSOF Versio 0.9 12-12-08 TW (Toon Witkam) 'toevoeging iPosOptionalHyphen '[12-12-08] als uitvoerparameter is voor een waarde die door KunmerAnaliz aan de oproepende macro's (TekstVortKontrol... ' ... en TEKSTanal) wordt doorgegeven [had misschien ook een PRIVATE variable kunnen zijn]; het betreft de beginpositie van het tweede hoofdbestanddeel... ' ....in een langere woordsamenstelling, een positie die logischerwijs geschikt is voor woordafbreking aan het eind van een tekstregel, een eventualiteit die... ' ...automatisch wordt ingebouwd door plaatsing van een zgn. "Optional Hyphen" (Unicode 31) in de MS WORD-brontekst; 'eerdere naam: PlurVortKunmetoEkzistVza6test, PlurVortKunmetoEkzist (deze 'plur'-versie zoekt door... ' ... tot alle mogelijke samenstellingen gevonden zijn, en kiest dan de meest waarschijnlijke VoorkeursOplossing daaruit); ' ... de aanpassing voor gebruik in MS-WORD-module dateert van 17 februari 2007; 'dit macro is bedoeld om na te gaan of een Woord een SAMENGESTELD Esp.-Woord is (VORTKUNMETAĴO); 'het esploreert of het Woord opsplitsbaar is in samenstellende delen, die in de Esperanto-woordenboeken (BRO, PIV en DICT3) voorkomen; ' 'InvoerWoord = woord dat door het oproepende programma bijv. uit een tekstwoordlijst is gehaald, en waarvan niet zeker is... ' ...of het wel een Esperanto-Woord is (kan een andertalig Woord, een fout Woord of een eigennaam zijn); 'Splitsing( ) = array van uitvoerresultaten, zijnde alle door dit macro gevonden mogelijke splitsingen in volgorde van waarschijnlijkheid, ... ' ...met daarin aangebrachte MORDIS-tekens (morfeemscheidings-tekens) tussen de samenstellende delen; ... ' ...oproepende programma's moeten rekening houden met maximaal 8 splitsingen; ' ...Splitsing(1) = VoorkeurSplitsing. 'nSplitsingen = totale aantal door het macro gevonden mogelijke splitsingen; is nul indien KunmetAnaliz=False; 'iPosOptionalHyphen = positie van precies dat MORDIS-teken, waar een "Optional Hyphen" (zoals gebruikt door MS Word voor het aangeven... ' ...van een acceptabele woordafbreking aan einde regel) het best geplaatst kan worden; ' ...geldt alleen voor Splitsing(1), de VoorkeurSplitsing. [12-12-2008] Dim woord As String Dim evtwoord As String Dim LenWoord As Integer Dim i As Long Dim indexSnijvlak As Integer 'index van hoofdlus in HoofdBlok; er zijn max. 30 snijvlakken; Dim nSnij As Integer 'alleen voor aanroep van onderliggende functies (SnijvlakImpossConsCluster etc.); Dim iSnij(30) As Integer 'alleen voor aanroep van onderliggende functies (SnijvlakImpossConsCluster etc.); 'Dim KlaBloInt3(160, 3) As Integer '[7-12-2006] Dim KlaBloInt3(16000, 3) As Integer '[19-10-2008] 'ruime hoeveelheid nodig bij CumulatiefKladblok ! Dim Lus1 As Integer Dim Lus2 As Integer Dim iKladBlokInvoerWoordBasis As Long Dim iKladblokSnijGroepBasis As Long Dim iKladblok As Long Dim hulp1 As Integer Dim hulp2 As String Dim Ondergrens As Integer Dim Bovengrens As Integer Dim iRecursieBeginKladblok(10) As Integer 'beginrij van iRecursie in de (belangrijke!) arrays c.q. Kladbloklijst van Snijvlakken; er zijn max. 4 ( = 5 - 1 ) recursies; Dim verhoogd tot 10 (om techn.redenen [14-02-2007] ) Dim iBeginMeestRechtseWoorddeel(30) As Integer 'beginpositie bij iRecursie van het meest rechtse woorddeel binnen het gehele invoerwoord; er zijn max. 30 snijvlakken Dim jRecursie As Integer Dim iBeginR As Integer 'beginpositie van KandidaatWoordRechts (bij Recursie: van het Meest Rechtse van de 3 Samenstellende Delen); Dim iBegin2 As Integer 'beginpositie van het Tweede van de (2 of 3) Samenstellende Delen; Dim iBeginM As Integer 'beginpositie van het Middelste van 3 Samenstellende Delen; Dim LenM As Integer Dim KandidaatWoordLinks(160) As String '[160 is gebaseerd op: max. 30 Snijvlakken (dus 30 array- of kladblok-regels), nog eens max. 4 x 30 bij recursie, en veiligheidsmarge 10 ] Dim KandidaatWoordRechts(160) As String Dim structLinks(160) As String Dim synmarkLinks(160) As Integer Dim genvocLinks(160) As Integer Dim structRechts(160) As String Dim synmarkRechts(160) As Integer Dim genvocRechts(160) As Integer Dim AffixScore(160) As Integer Dim DictScore(160) As Integer Dim CompoundLengte(160) As Integer Dim CompoundLengteMax As Integer Dim LengteScore(8) As Integer 'max. 8 Oplossingen Dim EindScore(8) As Integer Dim j As Integer Dim KandidaatWoordLinksinBRO As Boolean Dim KandidaatWoordLinksinPIV As Boolean Dim KandidaatWoordLinksinDICT3 As Boolean Dim KandidaatWoordRechtsinBRO As Boolean Dim KandidaatWoordRechtsinPIV As Boolean Dim KandidaatWoordRechtsinDICT3 As Boolean Dim DeelWoordLinksinDict As Boolean Dim DeelWoordRechtsinDict As Boolean Dim UitgangKandidaatWoordLinks As String Dim Drie1eLettersKandWoordRechts As String Dim LenKWRechts As Integer Dim MidLenKWRechts22 As String Dim LefLenKWRechts11 As String '[21-11-06] Dim Recursief As Boolean Dim iRecursie As Integer Dim EerderHerkendWoorddeelLinks(10) As String Dim GenVocEerderHerkendWdLinks(10) As Integer Dim iMidden As Integer Dim Samenstelling As String Dim LinkerWoorddeel As String Dim LenSamenstelling As Integer Dim nSnijSamenstelling As Integer Dim nSnijAlleRecursies As Integer Dim iSnijRecursieTrigger As Integer Dim MogelijkeSplitsing(8) As String Dim nResterendeSplitsingen As Integer Dim AffixStrategie As Boolean Dim DictStrategie As Boolean Dim nOplossingenAldanNietRecursief As Integer Dim nOplossingenNietRecursief As Integer Dim nOplossingenAlleRecursies As Integer Dim iOploss As Integer Dim nOplossingen As Integer 'nOplossingen cq nOplossingenAlleRecursies geeft het totaal aantal Oplossingen (gevonden splitsingen) aan; Dim SplitsingRijKladblok(8) As Integer 'relatieve positie in de Kladblok of Kladblokvervangende array, voor elk van de (max. 8) Oplossingen Dim RijCompoundLengteMax As Integer 'idem, voor de Oplossing met de max. lengte (als er meer Oplossingen met de max. lengte zijn: de 1e in Kladblok-volgorde) [17-02-2007] Dim NsnijNietRecursief As Integer 'aantal Snijvlakken (en dus aantal Kladblokrijen) vastgesteld in het niet-recursieve deel van KunmetAnaliz [17-02-2007] 'Dim BovengrensNietRecursief As Integer 'laatste Kladblokrij van het niet-recursieve deel van KunmetAnaliz [17-02-2007] Dim DictFactor As Integer 'gewicht (bij puntentelling) van DictScore [17-02-2007] Dim LengteFactor As Integer 'gewicht (bij puntentelling) van Compoundlengte [17-02-2007] Dim SnijvlakOpsplitsPositie As Integer Dim RecursieNaOplossing As Boolean '[*16-02-2007]: dit is een Stadium-Indicator, GEEN Optie-Schakelaar (zie daarvoor de "GoTo 370" tussen de labels 36 - 39) Dim RNOoptie As Boolean '[17-02-2006]: dit is de Schakelaar voor de Optie RNO: Recursie-Na-Oplossingen (ipv recursie enkel en alleen na uitblijven van oplossingen) Dim RecursieNaVerworpenOpl As Boolean '[17-10-2008]: betreft Recursie indien "gewone" Oplossingen allen verworpen zijn (door negatieve score) Dim Ambigumark As String '[30-1-2008] Dim Imin As Integer '[8-4-2008] Dim LenRechterWoorddeel As Integer '[29-6-2008] Dim NurAfAuMem As String '[15-8-08] Dim kwl As String '[18-8-08] Dim woordmetMorDISerin As String '[23-9-08] Dim CumulatiefKladBlok As Boolean '[19-10-08] Dim WstatWordtoExcel As Object '[30-10-06; alleen in de MS WORD-module] [26-5-08: raadselachtig waarom dit werkt, ipv via de PRIVATE in de module-Declarations] Set WstatWordtoExcel = GetObject(EspsofREGREZ) '[30-10-06; alleen in de WORD-module] [26-5-08: eveneens raadselachtig] With WstatWordtoExcel.worksheets(4) '[30-10-06; alleen in de MS WORD-module] '[28-2-08: Worksheetnummer veranderd van 5 in 4] KunmetAnaliz = False 'defaults RNOoptie = False '[17-02-2006] '(zie voor de RNO-optie enkele regels hierboven, en ook het codedeel tussen de labels 36 - 39) iPosOptionalHyphen = 0 '[12-12-08] RecursieNaVerworpenOpl = False '[17-10-2008] nSplitsingen = 0 For i = 1 To 8: Splitsing(i) = vbNullString: Next i '[*om het oproepende programma in geen geval te kunnen verwarren, zie ook onder labels 59 en 60 ] If InvoerWoord = "" Or InvoerWoord = " " Then GoTo 90 'lege cel If Len(InvoerWoord) < 4 Then GoTo 90 'Esp-woorden van minder dan 4 letters kunnen geen samenstelling zijn GoTo 1 ' <== s w i t c h CumulatiefKladBlok = True 'CUMULATIEVE KLADBLOK-ARCHIEF (de kladbloks van de afzonderlijke KunmetAnaliz-oproepen... '...worden onder elkaar geschreven, zodat naderhand vele Kunmeto-analyses gecontroleerd kunnen worden): iKladBlokInvoerWoordBasis = iKglobal + 5 'voorafgaand aan de nieuwe (actuele) kladblokgegevens wordt 5 regels verder gesprongen [19-10-08, ivm Solvoj in kolom FT] 'iKglobal is PRIVATE gedeclareerd aan het begin deze macro-module, en is dus een statische en 'globale' variabele: ... ' ...bij herhaalde aanroepen van KunmetAnaliz wordt iKglobal niet terug op nul gezet; dit bespaart processing tijd, omdat... ' ...er in de Kladblok-kolommen niet steeds "gezocht" hoeft te worden naar de eerste vrije rij; If iKglobal <= 4 Then 'beginsituatie: iKladBlokInvoerWoordBasis = 3 '[nooit hoger dan 8 maken] .Range("EX3:FW65300").Clear '[65000 rijen, de hele Excel-ruimte (bij Windows200 en Windows XP) kan worden gebruikt] MsgBox "Test-versie met KLADBLOK-ARCHIVERING voor INSPECTIE" End If If iKglobal > 65000 Then MsgBox "rij-index Kladblok (kolommen EY-FT) nadert Excel-maximum" '(absolute Excel-maximum = 65536) '[er zijn 3 macro's voorhanden (zie menu 'EspTests' in Excel menubalk) voor het visueel aantrekkelijk inrichten van de Kladblokruimte] 'Verder is voor de CumulatiefKladblok een RUIME DIMENSIONERING van Integer Array KlaBloInt3 nodig, bijv. KlaBloInt3(16000, 3) '[19-10-2008] GoTo 2 1: 'SLECHTS 1 KLADBLOK wordt getoond (bij elke oproep van KunmetAnaliz wordt het vorige kladblok overschreven): iKladBlokInvoerWoordBasis = 3 '[nooit hoger dan 8 maken] If iKglobal <= 4 Then iKglobal = 3 .Range("EX3:FW162").Clear '[160 rijen is een veilig maximum voor de Kladblokruimte benodigd voor 1 invoerwoord] '.Range(.Cells(3, "EY"), .Cells(iKglobal, "FZ")).Clear '[*maakt maximum overbodig, vereist echter wel dat iKglobal GLOBAL of STATIC is gedeclareerd] 2: 'Begin van de eigenlijke verwerking: woord = InvoerWoord Recursief = False iRecursie = 0 nSnijAlleRecursies = 0 nOplossingenAlleRecursies = 0 RecursieNaOplossing = False '[16-02-2007] 'Let op: dit betekent NIET dat deze optie is uitgeschakeld (zie hiervoor de SCHAKELAAR tussen labels 36 en 39) iKladblok = iKladBlokInvoerWoordBasis 5: 'Instappunt bij Recursie: LenWoord = Len(woord) iMidden = (LenWoord \ 2) + 1 'bijv.: iMidden=6 bij Lengte=11 .Cells(iKladblok + 1, "EY") = woord 'Woord' opslaan in Excel kolom EY (=kolom 155) If Recursief Then '.Cells(iKladblok + 1, "EY").Font.Underline = xlUnderlineStyleDouble 'TYDELYK AFGEZET ivm run-time error 1004 '[30-10-06] .Cells(iKladblok + 1, "EY").Font.ColorIndex = 48 'donkergrijs ipv zwart If LenWoord < 4 Then .Cells(iKladblok + 1, "FE").Value = "len < 4" '[*tot 10-10-06 was het criterium " < 6 letters" ] .Cells(iKladblok + 1, "FB").Value = 0 nOplossingen = 0 nSnij = 0 iKladblok = iKladblok + 1 GoTo 36 '(recursie op een woorddeel met lengte < 4 is kansloos, dus overspring Hoofdblok) End If Else 'if NOT Recursief Then: '.Cells(iKladblok + 1, "EY").Font.Underline = xlUnderlineStyleNone .Range(.Cells(iKladblok, "EY"), .Cells(iKladblok, "FT")).Interior.ColorIndex = 15 'grijs '(de grijze balk visualiseert het Kladblok-begin per aanroep van KunmetAnaliz) End If 'Snijvlak-opsporing : 'Door KunmetAnaliz worden ALLE mogelijke Samenstellingen van het invoerwoord opgespoord; KunmetAnaliz maakt... '...daartoe van elke letterpositie een potentieel Snijvlak, zolang er in elk van de Woord-Delen ... '...(van elk minstens 2 letters) ter weerszijden van dat Snijvlak tenminste 1 klinker zit. 'In het macrodeel HoofdBlok (label 20 tot label 36 hieronder) wordt achtereenvolgens voor de verschillende... '...potentiele Snijvlakken nagegaan of de Woord-Delen links en rechts ervan echte (in een Dictionary opgenomen)... '...Esperanto-woorden zijn. Daarbij wordt, indien er meerdere potentiele Snijvlakken zijn, begonnen met de Snijvlakken... '...die het dichts bij het MIDDEN van het woord liggen. Daarmee wordt beoogd, dat, indien de vele andere Strategische criteria ... '...geen duidelijke keuze voor een VoorkeursOplossing zouden bieden, de splitsing het dichtst bij het midden de voorkeur krijgt. If SnijvlakBezemwagen(woord, nSnij, iSnij) Then If Not Recursief Then .Cells(iKladblok + 1, "FE").Value = "Starto" 'markering in Kladblok van Begin van woord-analyse GoTo 20 Else 'Indien Geen Snijvlakken (Bezemwagen geeft lang niet altijd Snijvlakken): '.Cells(iKladblok + 1, "FB").Value = 0 'markeren in Kladblok met NUL GoTo 39 'overspring Hoofdblok End If 20: 'H O O F D B L O K : 'Verwerking bij 1 of MEERDERE SNIJVLAKKEN ------ RAADPLEGING DICTIONARIES: nOplossingen = 0 If Not CumulatiefKladBlok Then '[10-2-2007] bescherming tegen "subscript-out-of-range" van KlaBloInt3, waarvan max. range is gezet op 160 (zie DIM-stmt): If iKladblok + nSnij > 160 Then 'graceful degradation: woordherkenningsresultaat Negatief; markeren in Kladblok: .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = "N E P L I D A S P A C O" 'ter hoogte van invoerwoord... '[19-10-08] .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Font.ColorIndex = 3 '...met rood .Cells(iKladblok + 2, "FA").Value = "ZZZZZZZZ" 'onderaan in de KladBlok aldus markeren... '[19-10-08] .Cells(iKladblok + 2, "FA").Font.ColorIndex = 3 '...met rood GoTo 90 'de Kunmetanalyse voor dit woord overschrijdt de daarvoor ingestelde max. KladBlok-ruimte (daarom resultaat Negatief) End If Else 'bij CumulatiefKladBlok: If iKladblok + nSnij > 65300 Then 'Excel-ruimte nagenoeg uitgeput; markeren in Kladblok: .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = "N E P L I D A S P A C O" 'ter hoogte van invoerwoord... '[19-10-08] .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Font.ColorIndex = 3 '...met rood .Cells(iKladblok + 2, "FA").Value = "ZZZZZZZZ" 'onderaan in de KladBlok aldus markeren... '[19-10-08] .Cells(iKladblok + 2, "FA").Font.ColorIndex = 3 '...met rood GoTo 90 'de Kunmetanalyse voor dit woord overschrijdt de daarvoor ingestelde max. KladBlok-ruimte (daarom resultaat Negatief) End If End If ' For indexSnijvlak = 1 To nSnij KlaBloInt3(iKladblok + indexSnijvlak, 1) = iSnij(indexSnijvlak) '[*toegevoegd 7-12-2006] [*nieuwe naam "KlaBloInt3" dient zowel ter relatering aan als ter onderscheiding van "KlaBloInt" in 'VersneldeEspTextAnalyzer'] KlaBloInt3(iKladblok + indexSnijvlak, 2) = iSnij(indexSnijvlak) - iMidden '[*toegevoegd 7-12-2006] KlaBloInt3(iKladblok + indexSnijvlak, 3) = Abs(iSnij(indexSnijvlak) - iMidden) '[*toegevoegd 7-12-2006] Next indexSnijvlak 25: 'Sorteren op Kansrijkheid (het Midden van een woord wordt per default als Snijvlak het Meest Kansrijk geacht): Ondergrens = iKladblok + 1 Bovengrens = iKladblok + nSnij If Not Recursief Then NsnijNietRecursief = nSnij '[17-02-2007] 'If Not Recursief Then BovengrensNietRecursief = Bovengrens '[17-02-2007] 'Eerst Sorteren op kolom 3 ("FD"), sorteervolgorde = ascending: For Lus1 = Ondergrens To Bovengrens - 1 '[** -1 toegevoegd 24-10-06] For Lus2 = Lus1 + 1 To Bovengrens '[** +1 toegevoegd 24-10-06] If KlaBloInt3(Lus2, 3) < KlaBloInt3(Lus1, 3) Then hulp1 = KlaBloInt3(Lus1, 3) 'sorteer-stap op kolom FD KlaBloInt3(Lus1, 3) = KlaBloInt3(Lus2, 3) KlaBloInt3(Lus2, 3) = hulp1 hulp1 = KlaBloInt3(Lus1, 2) 'mee-sorteer-stap van kolom FC KlaBloInt3(Lus1, 2) = KlaBloInt3(Lus2, 2) KlaBloInt3(Lus2, 2) = hulp1 hulp1 = KlaBloInt3(Lus1, 1) 'mee-sorteer-stap van kolom FB KlaBloInt3(Lus1, 1) = KlaBloInt3(Lus2, 1) KlaBloInt3(Lus2, 1) = hulp1 End If Next Lus2 Next Lus1 'Een Snijvlak LINKS van het midden krijgt hierbij telkens prioriteit boven een snijvlak even ver rechts van het midden; 'om het omgekeerde te bereiken moet onderstaande code doorlopen worden (GoTo 27 uitschakelen): 'GoTo 27 '<=== SWITCH voor LINKS/RECHTS van MIDDEN For Lus1 = Ondergrens + 1 To Bovengrens Step 2 If Lus1 < Bovengrens Then If KlaBloInt3(Lus1, 2) = -KlaBloInt3(Lus1 + 1, 2) Then hulp1 = KlaBloInt3(Lus1, 1) 'verwissel twee Snijvlakken, zodat een Snijvlak RECHTS van het midden prioriteit krijgt boven een snijvlak even ver links van het midden KlaBloInt3(Lus1, 1) = KlaBloInt3(Lus1 + 1, 1) KlaBloInt3(Lus1 + 1, 1) = hulp1 End If End If Next Lus1 27: For indexSnijvlak = 1 To nSnij .Cells(iKladblok + indexSnijvlak, "FB") = KlaBloInt3(iKladblok + indexSnijvlak, 1) 'opslaan in Excel kolom FB (=kolom 158) '.Cells(iKladblok + indexSnijvlak, "FC") = KlaBloInt3(iKladblok + indexSnijvlak, 2) 'opslaan in Excel kolom FC (=kolom 159) '[*afgeschakeld 7-12-2006, opslag hiervan in Kladblok niet meer nodig] '.Cells(iKladblok + indexSnijvlak, "FD") = KlaBloInt3(iKladblok + indexSnijvlak, 3) 'opslaan in Excel kolom FD (=kolom 160) '[*afgeschakeld 7-12-2006, opslag hiervan in Kladblok niet meer nodig] Next indexSnijvlak If CumulatiefKladBlok Then .Cells(iKladblok + nSnij, "EX").Select 'zorgt voor automatisch omhoogschuiven bij tijdens run bekijken van Excel-sheet '[19-10-08] 30: 'Controleer de mogelijke twee Samenstellende WoordDelen op bestaanbaarheid: 'Nu 1 enkele lus door de Snijvlakken, waarbij per Snijvlak steeds al de Dictionaries (BRO, PIV, DICT3) worden geraadpleegd... ' ...totdat er een match met het linker- of rechter-woorddeel heeft plaatsgehad For indexSnijvlak = 1 To nSnij '------------------------------------------------------------------------------------------------------------------------------------------------------------------- If Recursief Then i = indexSnijvlak + iRecursieBeginKladblok(nOplossingenNietRecursief + iRecursie) - 1 '[de index i dient voor arrays zoals Struct, GenVoc e.d.] [14-02-2007] Else i = indexSnijvlak End If iBeginR = .Cells(iKladblok + indexSnijvlak, "FB").Value KandidaatWoordLinks(i) = Left(woord, iBeginR - 1) UitgangKandidaatWoordLinks = Right(KandidaatWoordLinks(i), 1) KandidaatWoordRechts(i) = Right(woord, LenWoord - (iBeginR - 1)) LenKWRechts = Len(KandidaatWoordRechts(i)) Drie1eLettersKandWoordRechts = Left(KandidaatWoordRechts(i), 3) DeelWoordLinksinDict = False DeelWoordRechtsinDict = False 'If BROonly Then NurAfOpcIV = "" '[18-8-08] NurAfAuMem = "" '[14-10-08] 'BRO ( B A Z A R A D I K A R O O F I C I A L A ) : 31: 'Controleer de bestaanbaarheid van beide kandidaat-woorden nu via Dictionary 1 (BRO): BROkunmetDeel = True '[16-10-08 21.15 h (rigoureuzere variant; vroegere naam 'BROlinksKunmet' is veranderd in 'BROkunmetDeel' ] '============Check LINKER Woorddeel op bestaan in Dictionary BRO: ============ KandidaatWoordLinksinBRO = False If Not (UitgangKandidaatWoordLinks = "o" Or UitgangKandidaatWoordLinks = "a" Or UitgangKandidaatWoordLinks = "e") Then '[*behandeling -en-woorden, herzien op 15-10-2005, niet vanuit dit BRO-blok (behalve bij BROonly) ] 'voeg -o toe als linker woordhelft NIET op -o, -a of -e eindigt: If BROonly Then 'BROlinksKunmet = True If Right(KandidaatWoordLinks(i), 2) <> "en" Then KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) Else 'mogelijke "EN"-uitgang (bij BROonly wordt, om dat te checken, gebruik gemaakt van een aparte kolom in VORTARO-BRO [23-9-08]): KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) If Not KandidaatWoordLinksinBRO Then 'indien NIET in de "EN"-kolom van VORTARO-BRO, dan betreft het mogelijk een woordstam op -en (bijv. "ten" als stam van "teni"): KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) '[25-9-08] End If End If Else 'If Not BROonly: 'BROlinksKunmet = True '***[16-10-08 18.20 uur]*** KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) End If ElseIf UitgangKandidaatWoordLinks = "o" Then 'een gewoon noun, waarvan de o-uitgang reeds (als tussen-o) in de Samenstelling staat: 'If BROonly Then '[gedisabled 14-10-08] 'BROlinksKunmet = True '[verplaatst naar binnenin onderstaande IFs, 14-10-08] kwl = KandidaatWoordLinks(i) If kwl = "hero" Then '[9-9-08 toegevoegde uitzondering ("heroo" is het enige BRO-woord op -oo) ] 'BROlinksKunmet = True KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) Else If kwl = "bo" Or kwl = "po" Or kwl = "pro" Then 'Or kwl = "tro" Then '[19-9-08: "ĉio-" verwijderd] 'BROlinksKunmet = True NurAfAuMem = "2" 'bij 4 prefixen: bo-, po-, pro-, tro- [bij "tro" wordt hier NurAfAuMem = "2" toegevoegd, hoewel die "2" bewust niet in VORTARO staat] End If KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) 'If NurAfOpcIV <> "2" And kwl <> "tro" Then structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) '[19-9-08: "And kwl <> tro" toegevoegd] '***[29-9-08: << If NurAfOpcIV <> "2" >> blijkt onjuist te zijn, dus is weggehaald; het wordt nu dus bijna altijd toevoegen van "o" ]: 'If kwl <> "tro" Then structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) '[1-10-08 (nieuwe poging, na fouten bij -o woorden:] 'If Not KandidaatWoordLinksinBRO Then '[14-10-08] ' 'BROlinksKunmet = False '[16-10-08 21.15h : BROlinksKunmet resetten leek hier nogal overbodig " 'Else 'If KandidaatWoordLinksinBRO: If KandidaatWoordLinksinBRO Then '[14-10-08] If Not (kwl = "bo" Or kwl = "po" Or kwl = "pro" Or kwl = "tro") Then structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) End If End If 'Else 'If Not BROonly: ' '[*behandeling oo-woord is herzien op 3-11-2005; nu niet meer vanuit dit BRO-blok] ' KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) ' structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) 'End If Else 'als de linker woordhelft op -a of -e eindigt (denk aan gevallen als 'nigrablanka', 'altedevena' ): 'If BROonly Then '[8-9-08] '[gedisabled 14-10-08] 'BROlinksKunmet = True '[te verplaatsen naar binnenin onderstaande IFs ?? 14-10-08] kwl = KandidaatWoordLinks(i) If Right(kwl, 1) = "e" Then If (Len(kwl) > 2 And Not (kwl = ChrW(265) & "ie" Or kwl = "tie" Or kwl = "nenie" Or kwl = "tre" Or kwl = "poste")) Or (kwl = "fe" Or kwl = "te") Then '(uitsluiten van: ĉe-, de-, ge-, ne-, re-, ĉie-, tie-, nenie-, tre-, poste- ) KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) '[19-9-08: "tre" toegevoegd] If NurAfAuMem <> "eo" Then '(uitsluiten van BRO-woorden op -eo: ale, arane, arme, asemble, fe, horde, ide, jubile, kre, lice, mediterane, muze, obe, ole, pane, pere, pice, te) KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) End If ElseIf kwl = ChrW(265) & "e" Or kwl = "de" Or kwl = "ge" Or kwl = "ne" Or kwl = "re" Then NurAfAuMem = "2" 'bij prefixen of prefix-gebruik van: ĉe-, de-, ge-, ne-, re-, tre- '[19-9-08: "tre" toegevoegd] KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) ElseIf kwl = ChrW(265) & "ie" Or kwl = "tie" Or kwl = "nenie" Or kwl = "tre" Or kwl = "poste" Then '[19-9-08: "tre" toegevoegd] NurAfAuMem = "2" 'bij prefix-gebruik van: ĉie-, tie-, nenie-, poste- (bijv. "ĉiekonata", "posteulo") KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) Else 'diverse e-uitgangen in kandidaat-Kunmetajho-helft, bijv. "se", "ve" 'MsgBox ("Else-tak 'diverse e-uitgangen' ") 'KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfOpcIV) 'structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) End If End If If Right(kwl, 1) = "a" Then 'in BRO zijn er 2 woorden op -ao: If kwl = "bala" Or kwl = "kaka" Then '(balao, kakao) KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) ElseIf Right(kwl, 2) = "ia" Or (kwl = "pra" Or kwl = "tra") Then NurAfAuMem = "2" 'bij 16 prefixen: kia-, tia-, ia-, ĉia-, nenia-, mia-, via-, lia-, ŝia-, ĝia-, nia-, ilia-, sia-, onia-, pra-, tra- KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) Else 'gewone a-uitgang in Kunmetajho-helft, bijv. "long-a" in "longaviva" KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), NurAfAuMem) structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) End If End If 'Else 'If Not BROonly: '[gedisabled 14-10-08] ' KandidaatWoordLinksinBRO = MatchEspWordToDict(KandidaatWoordLinks(i), "BRO", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) ' structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) ' If KandidaatWoordLinks(i) = "para" Then structLinks(i) = "para" & ChrW(MorDis) 'om te voorkomen dat het prefix "para" als "par-a" wordt weergegeven [*26-10-06] 'End If End If If Not BROonly Then '[behouden 14-10-08] If KandidaatWoordLinks(i) = "para" Then structLinks(i) = "para" & ChrW(MorDis) 'om te voorkomen dat het prefix "para" als "par-a" wordt weergegeven [*26-10-06] End If 3102: '============Check RECHTER Woorddeel op bestaan in Dictionary BRO: ============ KandidaatWoordRechtsinBRO = False 'If Right(KandidaatWoordRechts(i), 2) <> "en" Then '[*IF-stmt toegevoegd 12-11-2005; BRO niet raadplegen voor -en-woorden] ' <== If-stmt verwijderd [26-8-08] KandidaatWoordRechtsinBRO = MatchEspWordToDict(KandidaatWoordRechts(i), "BRO", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) 'End If If Not KandidaatWoordRechtsinBRO Then 'verwijder eens even de (ad-)verbale passief-suffixen "-at-" , "-it-" of "-ot-" (die gevolgd worden door een 1-letter uitgang: -a, -e, of -o): '[21-11-06] If LenKWRechts >= 3 Then MidLenKWRechts22 = Mid(KandidaatWoordRechts(i), LenKWRechts - 2, 2) If MidLenKWRechts22 = "at" Or MidLenKWRechts22 = "it" Or MidLenKWRechts22 = "ot" Then '[21-11-06] KandidaatWoordRechtsinBRO = MatchEspWordToDict _ (Left(KandidaatWoordRechts(i), LenKWRechts - 3) & "i", "BRO", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) '[ in BRO wordt alleen op radiko (stam) gematcht (dus bijv. in "menslavita" op "lav") ; MatchEspWordToDict vereist echter invoerparameters op -o, -a, -e of -i ] 'If KandidaatWoordRechtsinBRO Then KandidaatWoordRechts(i) = Left(KandidaatWoordRechts(i), LenKWRechts - 3) & " " & Right(KandidaatWoordRechts(i), 3) '[*bovenstaand stmt toegevoegd om het Strategisch Blok de mogelijkheid te geven bij bijv. "eksport ita" en "eks portita" te kunnen kiezen voor de eerste oplossing ] structRechts(i) = structRechts(i) & MidLenKWRechts22 & ChrW(MorDis) ' "at"/ "it"/"ot" -suffix ook in Struct toevoegen '[21-11-06] If synmarkRechts(i) = 9 Then synmarkRechts(i) = -9 '"Intransitive-Only"-stam is onverenigbaar met "at"/ "it"/"ot" -suffix en triggert daarom NEGATIEVE puntentelling '[21-11-06] End If End If End If 3105: '===================Resultaat raadpleging BRO: =================== If KandidaatWoordLinksinBRO And KandidaatWoordRechtsinBRO Then .Cells(iKladblok + indexSnijvlak, "FF").Value = "BRO" 'betekenis: BEIDE woordhelften in BRO. .Cells(iKladblok + indexSnijvlak, "FG").Value = "BRO" '[alleen ter betere visualisering in testversie] .Cells(iKladblok + indexSnijvlak, "FK").Value = "BRO" '[alleen ter betere visualisering in testversie] GoTo 35 'SKIP verdere Dicts Else 'Indien slechts 1 van beiden bestaat: If KandidaatWoordLinksinBRO Then .Cells(iKladblok + indexSnijvlak, "FG").Value = "BRO" If KandidaatWoordRechtsinBRO Then .Cells(iKladblok + indexSnijvlak, "FK").Value = "BRO" End If If BROonly Then GoTo 35 '2-8-08 BROkunmetDeel = False '[16-10-08 21.15 h (rigoureuzere variant; naam 'BROlinksKunmet' is veranderd in 'BROkunmetDeel' ] 'PIV ( N O V A P I V , enkomputiligita versio fare de Edmund Grimley Evans, kun korektoj el la "Provizora versio de 2004/01/05") : 32: 'Controleer de bestaanbaarheid van kandidaat-woorden nu via Dictionary PIV: '============Check LINKER Woorddeel op bestaan in Dictionary PIV: ============ KandidaatWoordLinksinPIV = False If KandidaatWoordLinksinBRO Then GoTo 3202 'SKIP verdere Dicts voor Linker Woorddeel If Not (UitgangKandidaatWoordLinks = "o" Or UitgangKandidaatWoordLinks = "a" Or UitgangKandidaatWoordLinks = "e") Then If Right(KandidaatWoordLinks(i), 2) = "en" Then 'adverbs op -en (suben, supren, norden, ...) If KandidaatWoordLinks(i) <> "en" And KandidaatWoordLinks(i) <> "sen" Then '[prefixen als "en" en "sen" gaan via speciale parameter 'S'] KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i), "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If KandidaatWoordLinksinPIV Then GoTo 3202 'adverb op -en (bijv. supren) heeft voorrang boven noun (bijv. supreno) End If End If 'voeg -o toe als linker woordhelft NIET op -o, -a of -e eindigt: KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) ElseIf UitgangKandidaatWoordLinks = "o" Then If MatchEspWordToDict(KandidaatWoordLinks(i), "Exceptions-oo", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) Then '(woord wordt aangeboden met uitgang -o of -oo) 'bijzondere nouns van het type "buroo, heroo, zoo, ...", of ze nu met 1 of 2 o's in de Samenstelling staan; indien met 2 o's, dan: If Right(KandidaatWoordLinks(i), 2) = "oo" Then structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) '[1-7-08] KandidaatWoordLinksinPIV = True Else 'een gewoon noun, waarvan de o-uitgang reeds (als tussen-o) in de Samenstelling staat: KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i), "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) End If Else 'als de linker woordhelft op -a of -e eindigt (denk aan gevallen als 'anglalingva', 'nigrablanka', 'altedevena' ... ): KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i), "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If Not KandidaatWoordLinksinPIV Then 'indien geen adjectief of adverb gevonden, voeg dan -o toe (het kan een woordstam van het type 'vilao', 'ŝoseo', 'perigeo'... betreffen): KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) Else structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) If KandidaatWoordLinks(i) = "para" Then structLinks(i) = "para" & ChrW(MorDis) 'om te voorkomen dat het prefix "para" als "par-a" wordt weergegeven [*26-10-06] End If End If 'Meestal is het samenstellende LINKER woorddeel een Noun, maar... If Not KandidaatWoordLinksinPIV Then '...indien het niet als -o woord in het Dictionary voorkomt, ... '...check dan (via speciale parameter 'S' ) of het als adjective/verb/adverb in het Dictionary voorkomt, ... '...(zelfs als het een -oo woord betreft: bijv. heroa, vetoi...): KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i) & "S", "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If Not KandidaatWoordLinksinPIV Then 'uitzondering voor gevallen als 'vivipova', 'produktipova', 'plaĉivola', 'pagideva' [zie PAG blz 419]: If UitgangKandidaatWoordLinks = "i" And (Drie1eLettersKandWoordRechts = "pov" Or Drie1eLettersKandWoordRechts = "vol" _ Or Drie1eLettersKandWoordRechts = "dev") Then KandidaatWoordLinksinPIV = MatchEspWordToDict(KandidaatWoordLinks(i), "PIV", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) structLinks(i) = structLinks(i) & "i" & ChrW(MorDis) End If 'uitzondering voor "tio" in woorden als "tiocele", "tiorilate" e.d. [11-1-2008]: If KandidaatWoordLinks(i) = "tio" Then KandidaatWoordLinksinPIV = True structLinks(i) = "ti" & ChrW(MorDis) & "o" & ChrW(MorDis) synmarkLinks(i) = 0: genvocLinks(i) = 0 'MsgBox "new code 11-1-08 for 'tio' used (in PIV-linker Woorddeel Hoofdblok KunmetAnaliz)" End If End If End If 3202: '============Check RECHTER Woorddeel op bestaan in Dictionary PIV: ============ KandidaatWoordRechtsinPIV = False If KandidaatWoordRechtsinBRO Then GoTo 3205 'SKIP verdere Dicts voor Rechter Woorddeel KandidaatWoordRechtsinPIV = MatchEspWordToDict(KandidaatWoordRechts(i), "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) If Not KandidaatWoordRechtsinPIV Then If Right(KandidaatWoordRechts(i), 1) = "e" Then 'vervang de uitgang "e" eens door "a" of door "o": KandidaatWoordRechtsinPIV = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "a", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) _ Or MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "a" Then 'vervang de uitgang "a" eens door "o": KandidaatWoordRechtsinPIV = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "o" Then 'vervang de uitgang "o" eens door "i": KandidaatWoordRechtsinPIV = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "i", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "i" Then 'vervang de uitgang "i" eens door "o": KandidaatWoordRechtsinPIV = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) End If End If If Not KandidaatWoordRechtsinPIV Then 'verwijder eens even de (ad-)verbale passief-suffixen "-at-", "-it-" of "-ot-" (die gevolgd worden door een 1-letter uitgang: -a, -e, of -o): '[21-11-06] If LenKWRechts >= 3 Then MidLenKWRechts22 = Mid(KandidaatWoordRechts(i), LenKWRechts - 2, 2) If MidLenKWRechts22 = "at" Or MidLenKWRechts22 = "it" Or MidLenKWRechts22 = "ot" Then '[21-11-06] KandidaatWoordRechtsinPIV = MatchEspWordToDict _ (Left(KandidaatWoordRechts(i), LenKWRechts - 3) & "i", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) structRechts(i) = structRechts(i) & MidLenKWRechts22 & ChrW(MorDis) ' "at"/ "it"/"ot" -suffix ook in Struct toevoegen '[21-11-06] 'If synmarkRechts(i) = 9 Then KandidaatWoordRechtsinPIV = False 'verworpen, want met "Intransitive-Only"-stam is "at" of "it" -suffix onverenigbaar! '[21-11-06] 'If synmarkRechts(i) = 9 Then nSplitsingen = 0: GoTo 59 'woord wordt geheel verworpen, want met "Intransitive-Only"-stam is "at" of "it" -suffix onverenigbaar! '[21-11-06] If synmarkRechts(i) = 9 Then synmarkRechts(i) = -9 '"Intransitive-Only"-stam is onverenigbaar met "at"/ "it"/"ot" -suffix en triggert daarom NEGATIEVE puntentelling '[21-11-06] End If End If End If If Not KandidaatWoordRechtsinPIV Then 'probeer tenslotte de "S"-kolom van het Dictionary (stammen van adjectieven, verbs en adverbs), 'die diverse (pseudo-)affixen bevat, waaronder ook zeer frequente: ag, et, ek, ebl, ge, ig, iĝ, post, um etc: LefLenKWRechts11 = Left(KandidaatWoordRechts(i), LenKWRechts - 1) '[21-11-06] KandidaatWoordRechtsinPIV = MatchEspWordToDict(LefLenKWRechts11 & "S", "PIV", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) '[21-11-06] If synmarkLinks(i) = 9 Then If LefLenKWRechts11 = "at" Or LefLenKWRechts11 = "it" Or LefLenKWRechts11 = "ot" Then synmarkLinks(i) = -9 '[21-11-06] End If '"Intransitive-Only"-stam is onverenigbaar met "at"/ "it"/"ot" -suffix en triggert daarom NEGATIEVE puntentelling '[21-11-06] End If 3205: '===================Resultaat raadpleging PIV: =================== If KandidaatWoordLinksinPIV And KandidaatWoordRechtsinPIV Then If GenVoc16only Then .Cells(iKladblok + indexSnijvlak, "FF").Value = "PIV16" 'betekenis: BEIDE woordhelften in PIV16 '[27-10-08] .Cells(iKladblok + indexSnijvlak, "FG").Value = "PIV16" '[alleen ter betere visualisering in testversie] .Cells(iKladblok + indexSnijvlak, "FK").Value = "PIV16" '[alleen ter betere visualisering in testversie] Else .Cells(iKladblok + indexSnijvlak, "FF").Value = "PIV" 'betekenis: BEIDE woordhelften in PIV. .Cells(iKladblok + indexSnijvlak, "FG").Value = "PIV" '[alleen ter betere visualisering in testversie] .Cells(iKladblok + indexSnijvlak, "FK").Value = "PIV" '[alleen ter betere visualisering in testversie] End If GoTo 35 'SKIP verdere Dicts Else 'Indien slechts 1 van beiden bestaat: If GenVoc16only Then If KandidaatWoordLinksinPIV Then .Cells(iKladblok + indexSnijvlak, "FG").Value = "PIV16" '[27-10-08] If KandidaatWoordRechtsinPIV Then .Cells(iKladblok + indexSnijvlak, "FK").Value = "PIV16" Else If KandidaatWoordLinksinPIV Then .Cells(iKladblok + indexSnijvlak, "FG").Value = "PIV" If KandidaatWoordRechtsinPIV Then .Cells(iKladblok + indexSnijvlak, "FK").Value = "PIV" End If End If If TutaPIV Or GenVoc16only Then GoTo 35 '2-8-08 'DICT3: T R I A ( A L D O N A ) V O R T A R O : 33: 'Controleer de bestaanbaarheid van beide kandidaat-woorden nu via Dictionary DICT3: '============Check LINKER Woorddeel op bestaan in Dictionary DICT3: ============ KandidaatWoordLinksinDICT3 = False If KandidaatWoordLinksinBRO Or KandidaatWoordLinksinPIV Then GoTo 3302 'SKIP verdere Dicts voor Linker Woorddeel '(**toegevoegd 4-9-2006) If Not (UitgangKandidaatWoordLinks = "o" Or UitgangKandidaatWoordLinks = "a" Or UitgangKandidaatWoordLinks = "e") Then If Right(KandidaatWoordLinks(i), 2) = "en" Then 'adverbs op -en (suben, supren, norden, ....) If KandidaatWoordLinks(i) <> "en" And KandidaatWoordLinks(i) <> "sen" Then '[prefixen als "en" en "sen" gaan via speciale parameter 'S'] KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i), "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If KandidaatWoordLinksinDICT3 Then GoTo 3302 'adverb op -en (bijv. supren) heeft voorrang boven noun (bijv. supreno) End If End If 'voeg -o toe als linker woordhelft NIET op -o, -a of -e eindigt: KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) ElseIf UitgangKandidaatWoordLinks = "o" Then '[*behandeling oo-woord is herzien op 3-11-2005; nu niet meer vanuit dit DICT3-blok] 'een gewoon noun, waarvan de o-uitgang reeds (als tussen-o) in de Samenstelling staat: KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i), "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) structLinks(i) = structLinks(i) & "o" & ChrW(MorDis) Else 'als de linker woordhelft op -a of -e eindigt (denk aan gevallen als 'anglalingva', 'nigrablanka', 'altedevena' ... ): KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i), "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If Not KandidaatWoordLinksinDICT3 Then 'indien geen adjectief of adverb gevonden, voeg dan -o toe (het kan een woordstam van het type 'vilao', 'ŝoseo', 'perigeo'... betreffen): KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i) & "o", "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) Else structLinks(i) = structLinks(i) & UitgangKandidaatWoordLinks & ChrW(MorDis) If KandidaatWoordLinks(i) = "para" Then structLinks(i) = "para" & ChrW(MorDis) 'om te voorkomen dat het prefix "para" als "par-a" wordt weergegeven [*26-10-06] End If End If 'Meestal is het samenstellende LINKER woorddeel een Noun, maar... If Not KandidaatWoordLinksinDICT3 Then '...indien het niet als -o woord in het Dictionary voorkomt, ... '...check dan (via speciale parameter 'S' ) of het als adjective/verb/adverb in het Dictionary voorkomt: KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i) & "S", "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) If Not KandidaatWoordLinksinDICT3 Then 'voorzie in gevallen als 'vivipova', 'plaĉivola', 'pagideva' [zie PAG blz 419]: If UitgangKandidaatWoordLinks = "i" And (Drie1eLettersKandWoordRechts = "pov" Or Drie1eLettersKandWoordRechts = "vol" _ Or Drie1eLettersKandWoordRechts = "dev") Then KandidaatWoordLinksinDICT3 = MatchEspWordToDict(KandidaatWoordLinks(i), "DICT3", structLinks(i), synmarkLinks(i), genvocLinks(i), Ambigumark) structLinks(i) = structLinks(i) & "i" & ChrW(MorDis) End If End If End If 3302: If Left(structLinks(i), 5) = "FFFFF" Then KandidaatWoordLinksinDICT3 = False 'ivm Blacklist-woorden in Dict3 [8-7-08] '============Check RECHTER Woorddeel op bestaan in Dictionary DICT3: ============ KandidaatWoordRechtsinDICT3 = False If KandidaatWoordRechtsinBRO Or KandidaatWoordRechtsinPIV Then GoTo 3305 'SKIP verdere Dicts voor Rechter Woorddeel '(**toegevoegd 4-9-2006) KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(KandidaatWoordRechts(i), "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) If Not KandidaatWoordRechtsinDICT3 Then If Right(KandidaatWoordRechts(i), 1) = "e" Then 'vervang de uitgang "e" eens door "a" of door "o": '[*9-4-05: toevoeging "o" ] KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "a", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) _ Or MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "a" Then 'vervang de uitgang "a" eens door "o": KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "o" Then 'vervang de uitgang "o" eens door "i": KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "i", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) ElseIf Right(KandidaatWoordRechts(i), 1) = "i" Then 'vervang de uitgang "i" eens door "o": KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(Left(KandidaatWoordRechts(i), LenKWRechts - 1) & "o", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) End If End If If Not KandidaatWoordRechtsinDICT3 Then 'verwijder eens even de (ad-)verbale passief-suffixen "-at-", "-it-" of "-ot-" (die gevolgd worden door een 1-letter uitgang: -a, -e, of -o): '[21-11-06] If LenKWRechts >= 3 Then MidLenKWRechts22 = Mid(KandidaatWoordRechts(i), LenKWRechts - 2, 2) If MidLenKWRechts22 = "at" Or MidLenKWRechts22 = "it" Or MidLenKWRechts22 = "ot" Then '[21-11-06] KandidaatWoordRechtsinDICT3 = MatchEspWordToDict _ (Left(KandidaatWoordRechts(i), LenKWRechts - 3) & "i", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) structRechts(i) = structRechts(i) & MidLenKWRechts22 & ChrW(MorDis) ' "at"/ "it"/"ot" -suffix ook in Struct toevoegen '[21-11-06] 'If synmarkRechts(i) = 9 Then KandidaatWoordRechtsinDICT3 = False 'verworpen, want met "Intransitive-Only"-stam is "at" of "it" -suffix onverenigbaar! '[21-11-06] 'If synmarkRechts(i) = 9 Then nSplitsingen = 0: GoTo 59 'woord wordt geheel verworpen, want met "Intransitive-Only"-stam is "at" of "it" -suffix onverenigbaar! '[21-11-06] If synmarkRechts(i) = 9 Then synmarkRechts(i) = -9 '"Intransitive-Only"-stam is onverenigbaar met "at"/ "it"/"ot" -suffix en triggert daarom NEGATIEVE puntentelling '[21-11-06] End If End If End If If Not KandidaatWoordRechtsinDICT3 Then 'probeer tenslotte de "S"-kolom van het Dictionary (stammen van adjectieven, verbs en adverbs), 'die diverse (pseudo-)affixen bevat, waaronder ook zeer frequente: ad, ant, ar, et, end, ek, ebl, ge, int, kontraŭ etc: LefLenKWRechts11 = Left(KandidaatWoordRechts(i), LenKWRechts - 1) '[21-11-06] KandidaatWoordRechtsinDICT3 = MatchEspWordToDict(LefLenKWRechts11 & "S", "DICT3", structRechts(i), synmarkRechts(i), genvocRechts(i), Ambigumark) '[21-11-06] If synmarkLinks(i) = 9 Then If LefLenKWRechts11 = "at" Or LefLenKWRechts11 = "it" Or LefLenKWRechts11 = "ot" Then synmarkLinks(i) = -9 '[21-11-06] End If '"Intransitive-Only"-stam is onverenigbaar met "at"/ "it"/"ot" -suffix en triggert daarom NEGATIEVE puntentelling '[21-11-06] End If If Left(structRechts(i), 5) = "FFFFF" Then KandidaatWoordRechtsinDICT3 = False 'ivm Blacklist-woorden in Dict3 [8-7-08] 3305: '===================Resultaat raadpleging DICT3: =================== If KandidaatWoordLinksinDICT3 And KandidaatWoordRechtsinDICT3 Then .Cells(iKladblok + indexSnijvlak, "FF").Value = "Dict3" 'betekenis: BEIDE woordhelften in DICT3. .Cells(iKladblok + indexSnijvlak, "FG").Value = "Dict3" '[alleen ter betere visualisering in testversie] .Cells(iKladblok + indexSnijvlak, "FK").Value = "Dict3" '[alleen ter betere visualisering in testversie] GoTo 35 'SKIP verdere Dicts Else 'Indien slechts 1 van beiden bestaat: If KandidaatWoordLinksinDICT3 Then .Cells(iKladblok + indexSnijvlak, "FG").Value = "Dict3" If KandidaatWoordRechtsinDICT3 Then .Cells(iKladblok + indexSnijvlak, "FK").Value = "Dict3" End If 35: 'BELANGRIJKE STAART HOOFDBLOK: DeelWoordLinksinDict = KandidaatWoordLinksinBRO Or KandidaatWoordLinksinPIV Or KandidaatWoordLinksinDICT3 DeelWoordRechtsinDict = KandidaatWoordRechtsinBRO Or KandidaatWoordRechtsinPIV Or KandidaatWoordRechtsinDICT3 'Check op DICT-bevestiging van het bestaan van TWEE Woord-Delen ter weerszijden van hetzelfde Snijvlak ..... If DeelWoordLinksinDict And DeelWoordRechtsinDict Then If .Cells(iKladblok + indexSnijvlak, "FF").Value <> "" Then ' .....bevestigd door EEN EN HETZELFDE Dictionary: 'invulling van Dict-naam in Kladblok heeft reeds plaatsgehad Else 'if .Cells(iKladblok + indexSnijvlak, "FF").Value = "" Then ' ....bevestigd door VERSCHILLENDE Dictionaries (bijv: 'abolita', 'mokatrinkaĵo', ' rekonsiderata'): 'invulling van samenvattende Dict-naam in Kladblok is uitgesteld en moet nu gebeuren: .Cells(iKladblok + indexSnijvlak, "FF").Value = "mix" End If 'Visualiseren van extra Dict-gegevens in de Kladblok [ALLEEN IN TESTVERSIE] : .Cells(iKladblok + indexSnijvlak, "FH").Value = structLinks(i) .Cells(iKladblok + indexSnijvlak, "FI").Value = synmarkLinks(i) .Cells(iKladblok + indexSnijvlak, "FJ").Value = genvocLinks(i) .Cells(iKladblok + indexSnijvlak, "FL").Value = structRechts(i) '[structRechts(i) kan op MorDis-teken eindigen, bij Rechter Deelwoorden op -en (12-02-2007) ] .Cells(iKladblok + indexSnijvlak, "FM").Value = synmarkRechts(i) .Cells(iKladblok + indexSnijvlak, "FN").Value = genvocRechts(i) 'N.B.: deze extra Dict-gegevens worden dus alleen in de Kladblok gevisualiseerd, indien er aan BEIDE zijden van het Snijvlak ... ' ... Deel-Woorden door Dictionaries bevestigd zijn; dit om de Kladblok niet nodeloos te overladen met gegevens, wat de overzichtelijkheid zou schaden. 'Voor ALLE zowel links als rechts bevestigde Compound-Splitsingen geldt: nOplossingen = nOplossingen + 1 SplitsingRijKladblok(nOplossingenNietRecursief + nOplossingenAlleRecursies + nOplossingen) = iKladblok + indexSnijvlak - iKladBlokInvoerWoordBasis '(identificatie dmv relatieve Kladblokpositie (rij) van de in kolom EZ aan te geven Oplossing) 'Woord-samenstelling VISUEEL zichtbaar maken in Kladblok-kolom "EZ" (=kolom 156): '.Cells(iKladblok + indexSnijvlak, "EZ").Value = KandidaatWoordLinks(i) & " " & KandidaatWoordRechts(i) '[ <= DUBBELE SPATIE, *versie van voor 24-10-06] 'If Right(structRechts(i), 3) <> "en" & ChrW(MorDis) Then '[*12-02-2007] If Right(structRechts(i), 4) <> ChrW(MorDis) & "en" & ChrW(MorDis) Then '[*13-02-2007] .Cells(iKladblok + indexSnijvlak, "EZ").Value = structLinks(i) & structRechts(i) & Right(KandidaatWoordRechts(i), 1) 'MORFEEM-STRUCTUUR, met uitgang van rechter woorddeel daaraan toegevoegd Else 'ingeval Rechter Deelwoord op -en eindigt: If Right(KandidaatWoordRechts(i), 2) = "en" Then '[18-05-2007:] deze beperkende conditie voorziet in... .Cells(iKladblok + indexSnijvlak, "EZ").Value = structLinks(i) & Left(structRechts(i), Len(structRechts(i)) - 1) '[ verwijderen van het MorDis-teken achter -EN uitgang (12-02-2007) ] Else '[18-05-2007:] ...aparte behandeling van woorden waarvan de woord-STAM eindigt op de Chemische of Zoologische Suffix "-en-" (meteno, tolueno, propeno, homeno, etc.): .Cells(iKladblok + indexSnijvlak, "EZ").Value = structLinks(i) & structRechts(i) & Right(KandidaatWoordRechts(i), 1) End If End If 'Bereken alvast de resulterende CompoundLengte ( = aantal tekens INCLUSIEF MORFEEMGRENZEN): If Recursief Then CompoundLengte(i) = Len(EerderHerkendWoorddeelLinks(nOplossingenNietRecursief + iRecursie)) + Len(.Cells(iKladblok + indexSnijvlak, "EZ").Value) Else CompoundLengte(i) = Len(.Cells(iKladblok + indexSnijvlak, "EZ").Value) End If 'Visualiseren van CompoundLengte in de Kladblok [ALLEEN IN TESTVERSIE] : .Cells(iKladblok + indexSnijvlak, "FQ").Value = CompoundLengte(i) ' in de kop van kolom FQ aangegeven met de afkorting "Len" End If 'Einde Hoofdblok Next indexSnijvlak '------------------------------------------------------------------------------------------------------------------------------------------------------ 36: 'MsgBox "Direct Na Hoofdblok" iKglobal = iKladblok + nSnij + 1 'rij die ondergrens aangeeft van gebruikte Kladblok-ruimte [van belang indien iKglobal STATIC is gedeclareerd] '.Cells(iKglobal, "FE").Select '[voor het DOORLOPEND VISUEEL zichtbaar maken van de ACTUELE Kladblok-ruimte] 'MsgBox nOplossingen & " oplossingen bij invoerwoord '" & woord & "'" If nOplossingen = 0 And Not Recursief Then GoTo 39 '(indien nog geen enkele samenstelling gevonden) 'Indien in recursie, ga dan door met de volgende recursie (niet in de diepte, maar in de breedte); ... '...pas als er geen verdere recursies meer mogelijk zijn, ga dan naar blok 370 (Strategisch Blok), waarin... '...ALLE tijdens de recursies (Recursie1, Recursie2, Recursie3, ..... ) gevonden oplossingen meekandidateren voor de VoorkeursOplossing If Recursief Then nSnijAlleRecursies = nSnijAlleRecursies + nSnij nOplossingenAlleRecursies = nOplossingenAlleRecursies + nOplossingen GoTo 392 Else '(bij GEEN recursie:) nOplossingenAldanNietRecursief = nOplossingen nOplossingenNietRecursief = nOplossingen '[16-02-2007] If Not RNOoptie Then GoTo 370 'ga NIET in recursie als er al 1 of meer Oplossingen zijn 'RNO-optie = Recursie-Na-Oplossing(en): '[als S C H A K E LA A R hiervoor dient bovenstaande boolean, die aan het begin van dit macro staat ingesteld] 'Indien Voorafgaand aan enige recursie er reeds 1 of meer Oplossing(en) gevonden zijn, ga dan toch in recursie, want ... '....de gevonden Oplossing(en) zijn misschien niet de goede [12-02-2007]: RecursieNaOplossing = True '[*12-02-2007] GoTo 40 '(voorbeelden die hiervan geprofiteerd hebben: 'enestrarigo', 'cxefdirektoraro', ...) [12-02-2007] End If 39: 'Bij de tot nu opgespoorde Snijvlakken GEEN Samenstelling gevonden van TWEE door Dictionary bevestigde Deelwoorden: 'dit is DE reden [en in de huidige strategie ook de Voorwaarde] om in Recursie te gaan: If Not Recursief Then If nSnij > 0 Then 'zolang er tenminste nog Snijvlak(ken) gevonden zijn: ... GoTo 40 '...ga de Recursie in; Else '...stop ermee zodra geen (verdere) Snijvlakken gevonden: '.Cells(iKladblok + nSnij + 1, "FB").Value = 0 'markeren in Kladblok met NUL , of zet... .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = "N E K O N A T A" 'ter hoogte van invoerwoord... .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Font.ColorIndex = 3 '...met rood .Cells(iKladblok + nSnij + 1, "FA").Value = "XXXXXXXX" 'onderaan in de KladBlok (onder de onderste Snijvlak-rij) aldus markeren... '[18-10-08] .Cells(iKladblok + nSnij + 1, "FA").Font.ColorIndex = 3 '...met rood GoTo 90 'woordherkenningsresultaat Negatief [ woord of samenstellende delen onbekend in de 3 Dictionaries: BRO, PIV, DICT3] End If End If 392: If Recursief Then iKladblok = iKladblok - 1 GoTo 40 'Ga door naar volgende Recursie-poging [N.B.: een paralelle, GEEN diepere recursie] in onderstaand Recursie-blok End If 40: 'RECURSIE-BLOK: 'MsgBox "Ingang Recursie-blok: iKladblokSnijGroepBasis = " & iKladblokSnijGroepBasis & " iRecursie = " & iRecursie 'Wel potentiele Snijvlakken, maar vooralsnog GEEN TWEE door dictionaries gedekte Samenstellende Woord-Delen gevonden 'Controleer Samenstellende Delen nu op bestaanbaarheid uitgaande van mogelijk 3 Samenstellende Delen: 'gebruik de Kladblok-kolommen FG en FK (=kolommen 163 en 167), die aangeven welke woord-helft... '...tenminste WEL bestaat; bekijk bij zo'n geval of het dan overgebleven Woord-Deel wederom... '...in 2 Samenstellende Delen gesplitst kan worden, en check daarvan weer de bestaanbaarheid (middels het HoofdBlok); ... '...doe dit door RECURSIE, met onderstaande overgangscode: If Not Recursief Then iKladblokSnijGroepBasis = iKladblok '(begin Kladblok-deel van de SnijGroep die aan de recursie voorafgaat) nSnijSamenstelling = nSnij '(lengte van Kladblok-deel van de SnijGroep die aan de recursie voorafgaat) Samenstelling = woord LenSamenstelling = LenWoord Recursief = True iRecursie = 1 iSnijRecursieTrigger = 1 'MsgBox "1e Recursie-poging" Else iRecursie = iRecursie + 1 If iRecursie > 4 Then 'MAXIMUM aantal recursies = 4 GoTo 50 End If woord = Samenstelling LenWoord = LenSamenstelling 'N.B.: een 2e en volgende recursie-poging betekent recursie vanaf een ander snijvlak; 'MsgBox "aanzet tot evt. Recursie " & iRecursie 'het betekent NIET geneste recursie op een dieper niveau: End If 'samenstellingen met meer dan 3 samenstellende delen (afgezien van -ata, -ita) worden genegeerd. 'If iSnijRecursieTrigger > nSnijSamenstelling Then GoTo 50 '[*12-02-2007] For i = iSnijRecursieTrigger To nSnijSamenstelling iBeginR = .Cells(iKladblokSnijGroepBasis + i, "FB").Value 'Zoek alleen snijvlakken met DICT-bevestiging LINKS maar niet rechts: If .Cells(iKladblokSnijGroepBasis + i, "FG") <> "" And .Cells(iKladblokSnijGroepBasis + i, "FK").Value = "" Then 'Rechter woorddeel is kandidaat voor recursie: evtwoord = Right(woord, LenWoord - (iBeginR - 1)) If RecursieNaOplossing And Right(evtwoord, 2) = "en" Then GoTo 49 'tenzij bij RecursieNaOplossing het rechter woorddeel eindigt op -en [17-02-2007, n.a.v. Kunmetaĵo zoals "ĉefurben" ] 'If OnmogelijkWoordBegin(evtwoord) Then MsgBox ("[Tijdelijke Test] OnmogelijkWoordBegin bij: " & evtwoord): GoTo 49 'tenzij het woorddeel begint met letters die voor een Esp.woord onmogelijk zijn If OnmogelijkWoordBegin(evtwoord) Then GoTo 49 'en tenzij het rechter woorddeel begint met letters die voor een Esp.woord onmogelijk zijn .Cells(iKladblokSnijGroepBasis + i, "FK").Value = "rekurs" & iRecursie 'vermeld in Kladblok het recursienummer daar waar de DICT-bevestiging ontbreekt .Cells(iKladblokSnijGroepBasis + i, "FK").Font.Size = 8 EerderHerkendWoorddeelLinks(nOplossingenNietRecursief + iRecursie) = structLinks(i) 'Struct van Linker woorddeel bewaren voor eindresultaat GenVocEerderHerkendWdLinks(nOplossingenNietRecursief + iRecursie) = genvocLinks(i) 'de GenVoc van het EerderHerkendWoorddeelLinks wordt later opgeteld bij die van in recursie gevonden Woorddelen, ... .Cells(iKladblokSnijGroepBasis + i, "FJ").Value = genvocLinks(i) '...en ter visuele controle ook in Kladblok genoteerd '[21-11-06] 'Op handen zijnde recursie ook VISUEEL zichtbaar maken in Kladblok-kolom "EZ" (=kolom 156): .Cells(iKladblokSnijGroepBasis + i, "EZ").Value = EerderHerkendWoorddeelLinks(nOplossingenNietRecursief + iRecursie) & " ........" '.Cells(iKladblokSnijGroepBasis + i, "EZ").HorizontalAlignment = xlLeft 'cell leftbound maken 'TYDELYK AFGEZET ivm run-time error 1004 [30-10-06] iBeginMeestRechtseWoorddeel(nOplossingenNietRecursief + iRecursie) = iBeginR 'beginpositie van het meest rechtse woorddeel binnen het gehele invoerwoord 'Nu rechter woorddeel ahw als nieuw woord gaan analyseren, inclusief het opnieuw bepalen van Snijvlakken '(eerder vastgestelde Snijvlakken kunnen nu afvallen, omdat zij te dicht bij het nieuwe woordbegin liggen): woord = evtwoord 'MsgBox "begin Recursie " & iRecursie & " (van Rechter woorddeel)" iKladblok = iKladblok + nSnij + 1 .Cells(iKladblok + 1, "FE").Value = "rekurs" & iRecursie 'vermeld in Kladblok ook aan begin van elk recursieblok het recursie-nummer iRecursieBeginKladblok(nOplossingenNietRecursief + iRecursie) = iKladblok + 1 - iKladBlokInvoerWoordBasis '[14-02-2007] iSnijRecursieTrigger = i + 1 GoTo 5 'Recursie End If 49: Next i 'Alleen bij (poging tot) Recursie nadat er al 1 'gewone' Oplossing was [12-02-2007]: If RecursieNaOplossing Then If nOplossingenAlleRecursies = 0 Then Recursief = False: GoTo 370 '(poging tot Recursie niet nodig gebleken) [##14-02-2007] 'if Recursief then GoTo 50 [14-02-2007] End If 50: 'TERUG UIT RECURSIE '[het macro komt nooit meer dan 1 keer Terug uit Recursie, en wel nadat ALLE recursie-pogingen (Recursie 1, Recursie 2, etc) doorlopen zijn] 'Na uitputtende recursie volgt hier de gang naar het selecteren van een VOORKEURS-Oplossing uit alle Samenstellings-kandidaten (tenzij er NUL kandidaten zijn): 'Ook komen we hier terecht als het MAX.ingestelde aantal recursies ( 4 ) is uitgevoerd: woord = Samenstelling LenWoord = LenSamenstelling nOplossingenAldanNietRecursief = nOplossingenNietRecursief + nOplossingenAlleRecursies '[14-02-2007] If RecursieNaVerworpenOpl Then nOplossingenAldanNietRecursief = nOplossingenAlleRecursies '[20-02-2007] If nOplossingenAlleRecursies > 0 Then iRecursieBeginKladblok(nOplossingenNietRecursief + iRecursie) = 160 '[veilige aanname voor max. aantal array- c.q. Kladblokregels (incl. recursies) per invoerwoord] '[14-02-2007] 'nOplossingenAldanNietRecursief = nOplossingenAlleRecursies '[weggehaald 14-02-2007] GoTo 370 'selecteren van een VOORKEURS-oplossing uit alle samenstellings-kandidaten End If If nOplossingenAldanNietRecursief = 0 Then 'markeren in Kladblok: .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = "N E K O N A T A" 'ter hoogte van invoerwoord... .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Font.ColorIndex = 3 '...met rood .Cells(iKglobal, "FA").Value = "XXXXXXXX" 'onderaan in de KladBlok (onder de onderste Snijvlak-rij)... '[18-10-08] .Cells(iKglobal, "FA").Font.ColorIndex = 3 '...met rood GoTo 90 'woordherkenningsresultaat Negatief [ woord of samenstellende delen onbekend in de 3 Dictionaries: BRO, PIV, DICT3 ] End If 370: ' S T R A T E G I S C H B L O K : -------------------------------------------------------------------------------------------------------------------------------------------- 'Uit het in totaal gevonden aantal mogelijke samenstellings-splitsingen wordt nu met verfijnde strategie een VOORKEURS-OPLOSSING gekozen: 'MsgBox "Kiezen VOORKEURS-OPLOSSING uit alle samenstellingen" & vbCr & vbCr & _ ' "nOplossingen (al dan niet Recursief) = " & nOplossingenAldanNietRecursief & " nSnijAlleRecursies = " & nSnijAlleRecursies 'SplitsingRijKladblok(i) = 'identificatie dmv relatieve Kladblokpositie (rij) van de in kolom EZ aangegeven Oplossing 'DictScore(i) = 'resulterend Gewicht op grond van de gezamenlijke Dictionary-voorkomens 'gevisualiseerd in: .Cells(iKladblok + i, "FP").Value 'AffixScore(i) = 'resulterend Gewicht op grond van bepaalde Affix-voorkomens 'gevisualiseerd in: .Cells(iKladblok + i, "FO").Value 'CompoundLengte(i) = 'aantal tekens INCLUSIEF MORFEEMGRENZEN 'Lengte (afgekort: "Len") 'DOORLOOP VAN ALLE VOORLOPIGE OPLOSSINGEN [in feite alle SAMENSTELLINGEN genoteerd in Kladblok-kolom "EZ"]: For iOploss = 1 To nOplossingenAldanNietRecursief '( = nOplossingenNietRecursief + nOplossingenAlleRecursies) '[14-02-2007] 'MsgBox "STRATEGIE-BLOK woord = " & woord & " Oplossing = " & iOploss SnijvlakOpsplitsPositie = .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FB").Value '[hulpvariabele, hieronder 3x gebruikt]] If iOploss > nOplossingenNietRecursief Then 'Recursieve Oplossingen [14-02-2007]: 'If Recursief Then For jRecursie = nOplossingenNietRecursief + 1 To nOplossingenNietRecursief + 4 'Recursieve Oplossingen [14-02-2007] 'For jRecursie = 1 To 4 ' iOploss is hier het volgnummer van de Oplossing '[bovengrens is gelijk aan het max. aantal ( 4 ) mogelijke Recursies ] If SplitsingRijKladblok(iOploss) >= iRecursieBeginKladblok(jRecursie) And SplitsingRijKladblok(iOploss) < iRecursieBeginKladblok(jRecursie + 1) Then GoTo 375 Next jRecursie ' jRecursie is de bij Oplossing iOploss horende iRecursie 375: 'iRecursie-woorddeel zit [sinds recursie-Halvering op 20-10-06] altijd aan de RECHTERKANT van het hele invoerwoord: iBeginR = iBeginMeestRechtseWoorddeel(jRecursie) - 1 + SnijvlakOpsplitsPositie iBegin2 = iBeginMeestRechtseWoorddeel(jRecursie) iBeginM = iBegin2 Else '(bij GEEN recursie:) iBeginR = SnijvlakOpsplitsPositie iBegin2 = iBeginR iBeginM = 0 End If 'SplitsingRijKladblok(iOploss) = identificatie dmv relatieve Kladblokpositie (rij) van de in kolom EZ aangegeven Oplossing 'iBeginR is hier de beginpositie (binnen het invoerwoord) van het Meest Rechtse van de (2 of 3) Samenstellende Delen; 'iBegin2 is de beginpositie (binnen het invoerwoord) van het Tweede van de (2 of 3) Samenstellende Delen; 'iBeginM is de beginpositie (binnen het invoerwoord) van het Middelste van 3 Samenstellende Delen; 380: If nOplossingenAldanNietRecursief = 1 Then GoTo 382 '(bij 1 Oplossing de positieve puntentoekenning overspringen) 'LenWoord en 'woord' hebben betrekking op het gehele invoerwoord (Samenstelling); 'STRATEGISCHE PUNTENTOEKENNING ivm AFFIXEN BIJ COMPOUND-SPLITTING: 'bij gevallen zoals bijvoorbeeld 'gaj nita' vs. 'gajn ita' voorkeur voor de variant met het GRAMMATICALE SUFFIX -ata/-ita, 'en zoals onderstaande lijst laat zien, op soortgelijke wijze bij vele andere suffixen en prefixen: '3-LETTER SUFFIXEN: If (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "at" Or Left(Right(woord, 3), 2) = "it" Or Left(Right(woord, 3), 2) = "ot") Then AffixScore(iOploss) = 10 'ata, ato, ate, ita, ito, ite, ota, oto, ote ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "ad") Then: AffixScore(iOploss) = 10 'ado, ada, ade ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "an" Or Left(Right(woord, 3), 2) = "ar") Then: AffixScore(iOploss) = 10 'ano, ana, ane, aro, ara, are ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "et" Or Left(Right(woord, 3), 2) = "eg") Then: AffixScore(iOploss) = 10 'eto, eta, ete, ego, ega, ege ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "ej" Or Left(Right(woord, 3), 2) = "ec") Then: AffixScore(iOploss) = 10 'ejo, eja. eje, eco, eca, ece ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "in" Or Left(Right(woord, 3), 2) = "ul") Then: AffixScore(iOploss) = 10 'ino, ina, ine, ulo, ula, ule ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "uj" Or Left(Right(woord, 3), 2) = "a" & ChrW(309)) Then: AffixScore(iOploss) = 10 'ujo, uja, uje, aĵo, aĵa, aĵe ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "em" Or Left(Right(woord, 3), 2) = "um") Then: AffixScore(iOploss) = 10 'emo, ema, eme, emi, umo, uma, ume, umi ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "ig" Or Left(Right(woord, 3), 2) = "i" & ChrW(285)) Then: AffixScore(iOploss) = 10 'igo, iga, ige, igi, iĝo, iĝa, iĝe, iĝi ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "ag") Then: AffixScore(iOploss) = 10 'ago, aga, age, agi '[*toegevoegd 16-10-06] ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "er") Then: AffixScore(iOploss) = 10 'ero, era, ere ElseIf (LenWoord - (iBeginR - 1) = 3) And (Left(Right(woord, 3), 2) = "iz" Or Left(Right(woord, 3), 2) = "iv") Then: AffixScore(iOploss) = 10 'izo, iza, ize, izi, ivo, iva, ive '4-LETTER SUFFIXEN: ElseIf (LenWoord - (iBeginR - 1) = 4) And (Left(Right(woord, 4), 3) = "ant" Or Left(Right(woord, 4), 3) = "int" Or Left(Right(woord, 4), 3) = "ont") Then: AffixScore(iOploss) = 10 'anta, inta, onta, anto, into, onto, ante, inte, onte ElseIf (LenWoord - (iBeginR - 1) = 4) And (Left(Right(woord, 4), 3) = "ist" Or Left(Right(woord, 4), 3) = "ism") Then: AffixScore(iOploss) = 10 'isto, ista, iste, ismo, isma, isme '[ ismo... toegevoegd 15-10-2005] ElseIf (LenWoord - (iBeginR - 1) = 4) And (Left(Right(woord, 4), 3) = "end" Or Left(Right(woord, 4), 3) = "ind") Then: AffixScore(iOploss) = 10 'endo, enda, ende, indo, inda, inde '4-LETTER PSEUDO-SUFFIXEN: ElseIf (LenWoord - (iBeginR - 1) = 4) And (Right(woord, 4) = "cele" Or Left(Right(woord, 4), 3) = "zon") Then: AffixScore(iOploss) = 10 'zono, zona, zone '5-LETTER PSEUDO-SUFFIXEN: ElseIf (LenWoord - (iBeginR - 1) = 5) And Left(Right(woord, 5), 4) = "stat" Then: AffixScore(iOploss) = 10 'stato, stata, state '[toegevoegd n.a.v. geval "alarm ostato"] '6-LETTER PSEUDO-SUFFIXEN: ElseIf (LenWoord - (iBeginR - 1) = 6) And (Right(woord, 6) = "opinie") Then: AffixScore(iOploss) = 10 End If '2-LETTER PREFIXEN: If (iBegin2 - 1 = 2) And (Left(woord, 2) = "re" Or Left(woord, 2) = "ek") Then 're, ek AffixScore(iOploss) = AffixScore(iOploss) + 10 ElseIf (iBegin2 - 1 = 2) And (Left(woord, 2) = "ge" Or Left(woord, 2) = "bo" Or Left(woord, 2) = "po") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'ge, bo, po ElseIf (iBegin2 - 1 = 2) And (Left(woord, 2) = "en" Or Left(woord, 2) = "ne") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'en, ne ElseIf (iBegin2 - 1 = 2) And (Left(woord, 2) = ChrW(265) & "e") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'ĉe '3-LETTER PREFIXEN: ElseIf (iBegin2 - 1 = 3) And (Left(woord, 3) = "kun" Or Left(woord, 3) = "sen" Or Left(woord, 3) = "eks") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'kun, sen, eks '[*16-11-06: 'kun' toegevoegd] ElseIf (iBegin2 - 1 = 3) And (Left(woord, 3) = "tiu" Or Left(woord, 3) = ChrW(265) & "iu") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'ĉiu ElseIf (iBegin2 - 1 = 3) And (Left(woord, 3) = "tri") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 ElseIf (iBegin2 - 1 = 3) And (Left(woord, 3) = "per" And (Right(woord, 1) = "a" Or Right(woord, 1) = "e")) Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 '(bijv. permaŝina, permane ) '4-LETTER PREFIXEN: ElseIf (iBegin2 - 1 = 4) And (Left(woord, 4) = "anti") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'anti ElseIf (iBegin2 - 1 = 4) And (Left(woord, 4) = "kelk") Then: AffixScore(iOploss) = AffixScore(iOploss) + 10 'kelk End If If iOploss > nOplossingenNietRecursief Then 'bij Recursieve Oplossingen [14-02-2007]: 'If Recursief Then LenM = iBeginR - iBeginM '2-LETTER INFIXEN (als midden-deel): If (LenM = 2) And (Mid(woord, iBeginM, 2) = "ig") Then AffixScore(iOploss) = AffixScore(iOploss) + 10 '(bijv. solidar-ig-ilo) End If 382: 'NEGATIEVE Punten-Toekenning [ bepaalde Samenstellings-Kandidaten kunnen hier worden 'afgekeurd' door ... '...toekenning van de negatieve score: AffixScore(iOploss) = -100; deze afkeuring kan ook plaatsvinden als er ... '...slechts 1 Samenstellings-Kandidaat is, en overrulet evt. prioriteiten die aan DictScore(iOploss) zijn toegekend ] : '"INTRANSITIVE-ONLY"-stam met PASSIEF ("at"/ "it"/"ot")-suffix '[21-11-06] 'signaal hiervoor is een synmarkLinks of synmarkRechts met in Hoofdblok toegekende negatieve waarde ( - 9): If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FI").Value = -9 _ Or .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FM").Value = -9 Then AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score '[21-11-06] End If '[21-11-06] '4-letter sufixen NEGATIEF: [8-7-08] If (LenWoord - (iBeginR - 1) = 5) And Left(Right(woord, 5), 4) = "gant" Then AffixScore(iOploss) = -20: GoTo 390 '"gant" is 'Hulsewort' voor "ant" [8-7-08] End If '3-letter prefixen NEGATIEF: If (iBegin2 - 1 = 3) And (Left(woord, 3) = "ant" Or Left(woord, 3) = "int" Or Left(woord, 3) = "ont") Then AffixScore(iOploss) = -100: GoTo 390 '(bijv. ant-onjo vs. antonjo ) ElseIf (iBegin2 - 1 = 3) And (Left(woord, 3) = "per" And Right(woord, 1) = "o") Then: AffixScore(iOploss) = -100: GoTo 390 '(bijv. per-versaĵo vs. pervers-aĵo ) End If '2-letter prefixen NEGATIEF [4-2-07]: If (iBegin2 - 1 = 2) And (Left(woord, 2) = "at" Or Left(woord, 2) = "it" Or Left(woord, 2) = "ot" Or Left(woord, 2) = "eg") Then AffixScore(iOploss) = -100: GoTo 390 '(bijv. 'at-en-tern-e' wordt verworpen; uitzonderingen: 'at-ist-o', 'it-ism-o' zijn via opname in Dict3 veiliggesteld [4-2-07] ) End If 'ook "eg" wordt als prefix fout gerekend [17-9-08] If iOploss > nOplossingenNietRecursief Then 'bij Recursieve Oplossingen [14-02-2007]: 'If Recursief Then LenM = iBeginR - iBeginM '2-letter infixen (als midden-deel) NEGATIEF: If (LenM = 2) And (Mid(woord, iBeginM, 2) = "ia") Then AffixScore(iOploss) = -100: GoTo 390 ElseIf (LenM = 2) And (Mid(woord, iBeginM, 2) = "at" Or Mid(woord, iBeginM, 2) = "it") And Len(woord) <> iBeginR + 2 Then AffixScore(iOploss) = -100: GoTo 390 'at, it, behalve indien daar precies 3 tekens tot het woordeinde op volgen, dit ivm gevallen als: -atino, -itulo, -itaĵo, .... '[*29-10-06] ElseIf (LenM = 2) And (Mid(woord, iBeginM, 2) = "mi" Or Mid(woord, iBeginM, 2) = "vi") Then: AffixScore(iOploss) = -100: GoTo 390 ElseIf (LenM = 2) And (Mid(woord, iBeginM, 2) = "li" Or Mid(woord, iBeginM, 2) = "ni") Then: AffixScore(iOploss) = -100: GoTo 390 ElseIf (LenM = 2) And (Mid(woord, iBeginM, 2) = "si" Or Mid(woord, iBeginM, 2) = "ci") Then: AffixScore(iOploss) = -100: GoTo 390 ElseIf (LenM = 2) And (Mid(woord, iBeginM, 2) = ChrW(349) & "i" Or Mid(woord, iBeginM, 2) = ChrW(285) & "i") Then: AffixScore(iOploss) = -100: GoTo 390 'ŝi, ĝi End If '3-letter infixen (als midden-deel) NEGATIEF: If (LenM = 3) And (Mid(woord, iBeginM, 3) = "oni" Or Mid(woord, iBeginM, 3) = "ili") Then AffixScore(iOploss) = -100: GoTo 390 'oni, ili End If End If 383: 'WEG-FILTEREN oplossingen met ADJ-NOUN of ADV-NOUN combinaties (blijkens PAG par. 309, blz. 418 komen die in Samenstellingen niet voor): 'kijk na of het linker- of midden-woorddeel (dus het woorddeel direct voorafgaand aan het meest rechtse van 2 of 3 samenstellende delen) ... '...eindigt op -a of -e (adjectief of adverb), en het meest rechtse woorddeel zelf eindigt op -o (noun); 'Dit is een NEGATIEVE puntentoekenning, waarbij ook checks op (pseudo-)prefixen betrokken zijn. If (Mid(woord, iBeginR - 1, 1) = "a") And (Right(woord, 1) = "o") Then If iBeginM = 0 Then LinkerWoorddeel = Left(woord, iBeginR - 1) 'bij 2 samenstellende delen Else LinkerWoorddeel = Right(Left(woord, iBeginR - 1), (iBeginR - 1) - (iBeginM - 1)) 'bij 3 samenstellende delen End If 'Checken of het linkerwoorddeel geen Noun op -ao (waarvan de uitgangs-o is weggelaten in de Samenstelling) ... ' ... dan wel een (pseudo-)prefix op -a bevat ( giga-, heksa-, hepta-, intra-, mega-, ...): If Not MatchEspWordToDict(LinkerWoorddeel, "Exceptions-ao", structLinks(iOploss), synmarkLinks(iOploss), genvocLinks(iOploss), "EindCheckExcept") And _ Not MatchEspWordToDict(LinkerWoorddeel, "Exceptions-a-prefix", structLinks(iOploss), synmarkLinks(iOploss), genvocLinks(iOploss), "EindCheckExcept") Then If Not (BROkunmetDeel And LinkerWoorddeel = "bala") Then '[9-9-08 toegevoegde conditie ("bala" is uniek geval in BROonly: het staat NIET in "Exceptions-ao") ] 'indien aan al deze voorwaarden is voldaam, dan: AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score, ... ' ... ook als er maar 1 Samenstellings-Kandidaat is) End If Else '[[8-4-2008, geinspireerd door een geval als de kunmetajho "erarooj" ]: 'het LinkerWoorddeel blijkt dus nu een "Exceptions-a-prefix" of de stam van een "Exceptions-ao"-woord te zijn; ... ' ... de "a" waarop het LinkerWoorddeel eindigt, is dus GEEN Finaĵo maar maakt deel uit van de STAM; ... ' ... corrigeer daarom zonodig het tussenresultaat in kolom EZ: Imin = iBeginM - 1 If iBeginM = 0 Then Imin = 0 If Left(.Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value, iBeginR - Imin) = _ Left(LinkerWoorddeel, Len(LinkerWoorddeel) - 1) & ChrW(MorDis) & "a" Then .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value = _ LinkerWoorddeel & Right(.Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value, _ Len(.Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value) - (Len(LinkerWoorddeel) + 1)) 'bijwerken overige gegevens in Kladblok: .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FH").Value = _ LinkerWoorddeel & ChrW(MorDis) 'bij woord uit Exceptions-lijst geen onderscheidende markering tussen PIV en Dict3, althans voor LinkerWoorddeel: .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FG").Value = "PIV" ' If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FK").Value = "PIV" Then .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FF").Value = "PIV" Else .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FF").Value = "mix" End If End If '[einde toevoeging 8-4-2008] End If End If If (Mid(woord, iBeginR - 1, 1) = "e") And (Right(woord, 1) = "o" Or Right(woord, 1) = "i") Then '[*het "i"-deel is toegevoegd op 7-12-2006] If iBeginM = 0 Then LinkerWoorddeel = Left(woord, iBeginR - 1) 'bij 2 samenstellende delen Else LinkerWoorddeel = Right(Left(woord, iBeginR - 1), (iBeginR - 1) - (iBeginM - 1)) 'bij 3 samenstellende delen End If 'Checken of het linkerwoorddeel geen Noun op -eo (waarvan de uitgangs-o is weggelaten in de Samenstelling) ... ' ... dan wel een (pseudo-)prefix op -e bevat ( de-, ge- ne-, pre-, re-, tele- ): If Not MatchEspWordToDict(LinkerWoorddeel, "Exceptions-eo", structLinks(iOploss), synmarkLinks(iOploss), genvocLinks(iOploss), "EindCheckExcept") And _ Not MatchEspWordToDict(LinkerWoorddeel, "Exceptions-e-prefix", structLinks(iOploss), synmarkLinks(iOploss), genvocLinks(iOploss), "EindCheckExcept") Then 'indien aan al deze voorwaarden is voldaam, dan: If Right(woord, 1) = "o" Then 'Uitzonderingen: LenRechterWoorddeel = Len(woord) - (iBeginR - 1) 'woorden als "unueklasito, longeforgesito, senzorgeprograminto" [29-6-08]: If LenRechterWoorddeel >= 5 And (Right(woord, 3) = "ato" Or Right(woord, 3) = "ito" Or Right(woord, 3) = "oto") Then GoTo 384 If LenRechterWoorddeel >= 6 And (Right(woord, 4) = "anto" Or Right(woord, 4) = "into" Or Right(woord, 4) = "onto") Then GoTo 384 'If BROonly And LinkerWoorddeel = "poste" Then GoTo 384 'woorden als "posteulo", "postesigno" [10-9-08] If Not (BROonly Or GenVoc16only) And LinkerWoorddeel = "poste" Then GoTo 384 'woorden zoals "posteulo", "postesigno" [14-10-08: juist alleen bij Opcio I en II ] 'Else [einde uitzonderingen]: AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score, ... ' ... ook als er maar 1 Samenstellings-Kandidaat is) End If If Right(woord, 1) = "i" Then AffixScore(iOploss) = -20 'bij "i" wordt de oplossing niet afgekeurd (denk bijv. aan 'supreteni'), ... '... maar krijgt wel een negatief gewicht '[*toegevoegd 7-12-2006, naar aanleiding van commentaar Victor Sadler op 23-11-2006] End If End If 384: 'INCIDENTELE GEVALLEN bij TELWOORDEN: '[4-2-07] If (iBegin2 - 1 = 2) And (Left(woord, 2) = "de") Then If Mid(woord, 3, 4) = "koka" Or Mid(woord, 3, 4) = "kuni" Then AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If 'dit voorkomt de zinloze KunmetAnalizo "de-kok-a" ipv "dek-ok-a", en "de-kun-u" ipv "dek-unu" '[4-2-07] End If If (iBegin2 - 1 = 2) And (Left(woord, 2) = "mi") Then If Mid(woord, 3, 4) = "loka" Or Mid(woord, 3, 4) = "luni" Then AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If 'dit voorkomt de zinloze KunmetAnalizo "mi-lok-a" ipv "mil-ok-a", en "mi-lun-u" ipv "mil-unu" '[4-2-07] End If 385: 'INCIDENTELE GEVALLEN bij 2-LETTER-MORFEMEN: '[10-1-08] ' "-aj-" [PIV: interjekcio, met sublemma "~i" oftewel "aj-i"] mag niet leiden tot toelating van ".....-aj-o" als kunmeto, ... ' ...want dat is vrijwel zeker een (frequente!) scan- of typefout van ".....-aĵ-o"; daarentegen is "la maljunulino ajajis" wel toe te laten: If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FL").Value = "aj" & ChrW(MorDis) Then 'RechtseWoorddeel = "aj-" If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FH").Value <> "aj" & ChrW(MorDis) Then 'LinkseWoorddeel <> "aj-" AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If End If ' "-ti-" [PIV: "ti/o", "~e"] is nooit zinvol in een kunmeto als het niet gevolgd wordt door "-o-" of "-a-" (bijv. "tiorilate", "tiaspece"): If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FH").Value = "ti" & ChrW(MorDis) Then 'LinkseWoorddeel = "ti-" If Not (.Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FL").Value = "o" & ChrW(MorDis) _ Or .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FL").Value = "a" & ChrW(MorDis)) Then 'RechtseWoorddeel <> "o-" of "a-" AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If End If If .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FL").Value = "ti" & ChrW(MorDis) Or _ .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FL").Value = "anti" & ChrW(MorDis) Then 'RechtseWoorddeel = "-ti-" of "-anti-" AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score [13-1-08] End If 386: 'INCIDENTELE GEVALLEN VAN MORFEEM-SEQUENTIES [23-9-08, bij bouw BROonly]: woordmetMorDISerin = .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value 'Wegfilteren van If Right(woordmetMorDISerin, 5) = ChrW(MorDis) & "en" & ChrW(MorDis) & "o" Then '(sequentie "-en-o" aan deelwoordeinde, in bijv. "rev-en-o") AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If If Left(woordmetMorDISerin, 5) = "en" & ChrW(MorDis) & "o" & ChrW(MorDis) Then '(sequentie "en-o-" aan deelwoordbegin, in bijv. "[rev]-en-o-tag-o") AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If If InStr(2, woordmetMorDISerin, ChrW(MorDis) & "en" & ChrW(MorDis) & "o" & ChrW(MorDis)) Then '(sequentie "-en-o-" middenin woord, in bijv. "rev-en-o-tag-o") AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If 'Wegfilteren van sequenties "-a-o-" en "-e-o-" middenin een samengesteld woord [29-9-08, bij bouw BROonly]: If InStr(2, woordmetMorDISerin, ChrW(MorDis) & "a" & ChrW(MorDis) & "o" & ChrW(MorDis)) Then '(sequentie "-a-o-" middenin woord, in bijv. "ĉi-a-o-kaze") AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If If InStr(2, woordmetMorDISerin, ChrW(MorDis) & "e" & ChrW(MorDis) & "o" & ChrW(MorDis)) Then '(sequentie "-e-o-" middenin woord, in bijv. "post-e-o-kaze") AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score End If 'Wegfilteren van sequentie "-o-o-" middenin een samengesteld woord [14-10-08, maar bleek overbodig]: 'If InStr(2, woordmetMorDISerin, ChrW(MorDis) & "o" & ChrW(MorDis) & "o" & ChrW(MorDis)) Then '(sequentie "-e-o-" middenin woord, in bijv. "post-e-o-kaze") ' AffixScore(iOploss) = -100: GoTo 390 'de oplossing wordt 'afgekeurd' door toekenning van de negatieve score 'End If 'STRATEGISCHE P U N T E N T O E K E N N I N G ivm DICTIONARY-COVERAGE van samenstellende woorddelen: 390: 'Ongeacht het Dictionary (BRO, PIV, SCHUETZ, Exceptions) worden 'DictFactor' scorepunten toegekend bij GenVoc=16 '( GenVoc = Cat. 16 betekent: woorddeel behoort tot General Vocabulary en/of is Official Esp. Woord): If RecursieNaOplossing And SplitsingRijKladblok(iOploss) > NsnijNietRecursief Then DictFactor = 2 Else DictFactor = 10 'geef minder gewicht bij Recursie Na Oplossing [17-02-2007]: If genvocLinks(SplitsingRijKladblok(iOploss)) = 16 Then DictScore(iOploss) = DictScore(iOploss) + DictFactor If genvocRechts(SplitsingRijKladblok(iOploss)) = 16 Then DictScore(iOploss) = DictScore(iOploss) + DictFactor If iOploss > nOplossingenNietRecursief Then 'bij Recursieve Oplossingen [14-02-2007]: 'laat de GenVoc van het bij recursie EerderHerkendWoordLinks ook meetellen [2006] .... 'If Not RecursieNaOplossing Then '...behalve bij RecursieNaOplossing, want die mag niet te zwaar wegen [17-02-2007]: '[*later op 17-02-2007 vervangen door DictFactor=5 ] If GenVocEerderHerkendWdLinks(jRecursie) = 16 Then DictScore(iOploss) = DictScore(iOploss) + DictFactor '[21-11-06] 'End If End If 'Vermeld AFFIX- EN DICT- SCORES, alsmede COMPOUND-LENGTE ook in Kladblok [in Testversie]: .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FO").Value = AffixScore(iOploss) .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FP").Value = DictScore(iOploss) Next iOploss '==================================================================================================== 'EINDE DOORLOOP DOOR ALLE VOORLOPIGE OPLOSSINGEN 'MsgBox "Einde Doorloop Alle Voorlopige Oplossingen"" '----------------------------------------------------- K E U Z E UIT DE VERSCHILLENDE OPLOSSINGEN: ------------------------------------------------------------- 'CompoundLengte ( = aantal tekens INCLUSIEF MORFEEMGRENZEN) van een oplossing: If nOplossingenAldanNietRecursief > 1 Then 'Laat verschillen in CompoundLengtes meewegen in de Scoreberekening (prefereer het MINSTE aantal morfeemscheiders, conform de REICHLING-stelling); CompoundLengteMax = CompoundLengte(SplitsingRijKladblok(1)) RijCompoundLengteMax = SplitsingRijKladblok(1) '[17-02-2007] For iOploss = 2 To nOplossingenAldanNietRecursief '[de bovengrens staat hiermee feitelijk ofwel op 'nOplossingen' (indien geen recursie), ofwel op 'nOplossingenAlleRecursies' ] If CompoundLengte(SplitsingRijKladblok(iOploss)) > CompoundLengteMax Then 'bepaal de maximale CompoundLengte CompoundLengteMax = CompoundLengte(SplitsingRijKladblok(iOploss)) RijCompoundLengteMax = SplitsingRijKladblok(iOploss) '[17-02-2007] End If Next iOploss If RecursieNaOplossing Then '[17-02-2007] If RijCompoundLengteMax > NsnijNietRecursief Then 'maximale Compoundlengte in Recursieve deel LengteFactor = 10 'indien het Recursieve deel grotere Compoundlengte(s) oplevert dan het Niet-Recursieve,... '....wordt dit afgestraft door aan de KORTERE Oplossing(en) van het Niet-Recursieve deel een extra LengteFactor-voordeel te geven '[17-02-2007]; Else LengteFactor = 5 End If Else LengteFactor = 5 End If 'bepaal vervolgens van alle anderen HOEVEEL KORTER zij zijn dan de langste, en vermenigvuldig dat verschil met de LengteFactor: For iOploss = 1 To nOplossingenAldanNietRecursief '[de bovengrens staat hiermee feitelijk ofwel op 'nOplossingen' (indien geen recursie), ofwel op 'nOplossingenAlleRecursies' ] LengteScore(iOploss) = (CompoundLengteMax - CompoundLengte(SplitsingRijKladblok(iOploss))) * LengteFactor 'het verschil met de maximale CompoundLengte wordt vermenigvuldigd met de LengteFactor, ... '...wat betekent dat de Oplossing die een MORFEEMGRENS minder heeft (1 teken kortere lengte), wordt BELOOND met score-puntenaantal gelijk aan de LengteFactor; .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FR").Value = LengteScore(iOploss) 'aangegeven met de afkorting "Lon" in de kop van kolom FR Next iOploss End If 'Bepaal nu de Eindscores van de verschillende oplossingen (zowel Affix-score als Dict-score als Lengte-score worden in de Eindscore verwerkt): For iOploss = 1 To nOplossingenAldanNietRecursief '[de bovengrens staat hiermee feitelijk ofwel op 'nOplossingen' (indien geen recursie), ofwel op 'nOplossingenAlleRecursies' ] EindScore(iOploss) = AffixScore(iOploss) + DictScore(iOploss) + LengteScore(iOploss) .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "FS").Value = EindScore(iOploss) 'vermeld de EindScore ook in de extra Kladblok-kolom "FS" '**voor Testversie MogelijkeSplitsing(iOploss) = .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(iOploss), "EZ").Value '(alvast voor handige sortering van oplossingen, hieronder) Next iOploss nResterendeSplitsingen = 1 '(default) If nOplossingenAldanNietRecursief = 1 Then If EindScore(1) < 0 Then GoTo 59 '(de enige Oplossing kan negatief zijn!) ElseIf nOplossingenAldanNietRecursief > 1 Then 'Sorteer array EindScore descending (hoogste EindScore vooraan in array): For iOploss = 1 To nOplossingenAldanNietRecursief - 1 For j = iOploss + 1 To nOplossingenAldanNietRecursief If EindScore(j) > EindScore(iOploss) Then hulp1 = EindScore(iOploss) 'sorteer-stap van array EindScore( ) EindScore(iOploss) = EindScore(j) EindScore(j) = hulp1 hulp1 = SplitsingRijKladblok(iOploss) 'mee-sorteer-stap van array SplitsingRijKladblok( ) SplitsingRijKladblok(iOploss) = SplitsingRijKladblok(j) SplitsingRijKladblok(j) = hulp1 hulp2 = MogelijkeSplitsing(iOploss) 'mee-sorteer-stap van Oplossingen zelf (compound strings) uit kolom EZ MogelijkeSplitsing(iOploss) = MogelijkeSplitsing(j) MogelijkeSplitsing(j) = hulp2 End If Next j Next iOploss For i = 1 To nOplossingenAldanNietRecursief If EindScore(i) < 0 Then Exit For 'array afkappen zodra EindScores NEGATIEF worden Next i nResterendeSplitsingen = i - 1 '( = nOplossingenAldanNietRecursief indien er GEEN negatieve EindScores zijn) If nResterendeSplitsingen = 0 Then GoTo 59 '(alle Oplossingen kunnen negatief zijn!) '[21-11-06] End If 'SplitsingRijKladblok(1) is de Winnaar, met HOOGSTE Eindscore .Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(1), "EZ").Font.ColorIndex = 31 'gekozen Oplossing in kolom EZ groen aangeven If jRecursie = 0 Then iPosOptionalHyphen = Len(.Cells(iKladBlokInvoerWoordBasis + SplitsingRijKladblok(1), "FH").Value) + 1 '[12-12-08] If jRecursie > 0 Then iPosOptionalHyphen = Len(EerderHerkendWoorddeelLinks(jRecursie)) + 1 '[12-12-08] 'Het TOTAAL aan Oplossingen (zonder de verwijderde negatieven, dus no. 1 t/m 'ResterendeSplitsingen') in array MogelijkeSplitsing( ) opslaan: For i = 1 To nResterendeSplitsingen If iOploss > nOplossingenNietRecursief Then 'Recursieve Oplossingen [14-02-2007]: 'If iOploss = 2 And nOplossingenNietRecursief = 1 Then MsgBox ("mogelijke fout: iOploss=2 en nOplossingenNietRecursief =1") '[TEST 12-12-08] 'If Recursief Then For jRecursie = nOplossingenNietRecursief + 1 To nOplossingenNietRecursief + 4 'Recursieve Oplossingen [14-02-2007] 'For jRecursie = 1 To 4 If SplitsingRijKladblok(i) >= iRecursieBeginKladblok(jRecursie) And SplitsingRijKladblok(i) < iRecursieBeginKladblok(jRecursie + 1) Then Exit For Next jRecursie ' jRecursie is de bij Oplossing iOploss horende iRecursie MogelijkeSplitsing(i) = EerderHerkendWoorddeelLinks(jRecursie) & MogelijkeSplitsing(i) '[###14-02-2007: hier was subscript out of range bij eerste loop-doorloop; 1x overspringen van het stmt leverde toen toch perfect eindresultaat] '[*na HALVERING recursies op 20-10-06 geldt altijd: EerderHerkendWoorddeelRechts = ""] End If Next i 'Nu nog array van MogelijkeSplitsing checken op GELIJKE Splitsingen [*blijft van belang bij morfeem-STRUCT -representatie]: For i = 1 To nResterendeSplitsingen MogelijkeSplitsing(i) = MogelijkeSplitsing(i) For j = i + 1 To nResterendeSplitsingen If MogelijkeSplitsing(j) = MogelijkeSplitsing(i) Then For hulp1 = j To nResterendeSplitsingen - 1 'elk dubbel exemplaar van GELIJKE splitsingen wordt uit de array verwijderd (en de arraylengte krimpt) MogelijkeSplitsing(j) = MogelijkeSplitsing(j + 1) Next hulp1 nResterendeSplitsingen = nResterendeSplitsingen - 1 End If Next j Next i 'Nummer 1 van de array is de 'Winnaar' oftewel de GekozenSplitsing: 'nResterendeSplitsingen = het totaal aantal Splitsingen dat resteert na verwijdering van dubbele exemplaren GoTo 60 'EINDE VAN STRATEGISCH BLOK --------------------------------------------------------------------------------- 59: 'NEGATIEF: 'Alle voorlopige oplossingen verworpen: '-- - - - - - - - -- - - - - --- - - - -- -- - - ---- -- - - - - - - - - - - - - - - -- - - - - --- - - - -- -- - - ---- -- - - - - - -[17-10-08]: If Not Recursief And Not RecursieNaVerworpenOpl Then '[17-10-18:] RNVO - Recursief Na Verworpen Oplossing: If BROonly Or GenVoc16only Then '(RNVO is vooral zinvol bij BROonly of GenVoc16only) RecursieNaVerworpenOpl = True 'ga alsnog in Recursie indien er niet eerder Recursie heeft plaatsgehad [17-10-08] GoTo 40 'herkansing End If End If '-- - - - - - - - -- - - - - --- - - - -- -- - - ---- -- - - - - - - - - - - - - - - -- - - - - --- - - - -- -- - - ---- -- - - - - - - 'Markeren in Kladblok: .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = "N E K O N A T A" 'ter hoogte van invoerwoord... .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Font.ColorIndex = 3 '...met rood .Cells(iKglobal, "FA").Value = "XXXXXXXX" 'onderaan in de KladBlok (onder de onderste Snijvlak-rij)... '[18-10-08] .Cells(iKglobal, "FA").Font.ColorIndex = 3 '...met rood 'Uitvoerparameters behouden hun default value: 'KunmetAnaliz = False 'nSplitsingen = nResterendeSplitsingen = 0 'Splitsing(1 t/m 8) = "" GoTo 90 'woordherkenningsresultaat Negatief [ woord of samenstellende delen onbekend in de 3 Dictionaries: BRO, PIV, DICT3] 60: 'POSITIEF: 'Er is een VoorkeurSplitsing gevonden, benevens evt. resterende splitsingen. 'Maak Gekozen VoorkeurSplitsing zichtbaar in Kladblok-kolom FA (ter hoogte van het invoerwoord in kolom EY): .Cells(iKladBlokInvoerWoordBasis + 1, "FA").Value = MogelijkeSplitsing(1) ' = VoorkeurSplitsing 'Zet de Uitvoerparameters: KunmetAnaliz = True nSplitsingen = nResterendeSplitsingen Select Case nSplitsingen Case 1 .Cells(iKglobal, "FT").Value = " s1:" 'onderaan in de KladBlok (onder de onderste Snijvlak-rij) '[18-10-08] Case 2 .Cells(iKglobal, "FT").Value = " s1, s2:" Case 3 .Cells(iKglobal, "FT").Value = " s1, s2, s3:" Case 4 .Cells(iKglobal, "FT").Value = " s1, s2, s3, s4:" Case Else .Cells(iKglobal, "FT").Value = " s1, s2, s3, s4, ....:" End Select For i = 1 To nSplitsingen Splitsing(i) = MogelijkeSplitsing(i) 'Splitsing(1) = VoorkeurSplitsing '.Cells(iKladBlokInvoerWoordBasis + 1 + i, "FT").Value = " " & Splitsing(i) .Cells(iKglobal + i, "FT").Value = " " & Splitsing(i) Next i '[ om het oproepende programma in geen geval te kunnen verwarren, is de array Splitsingen (1 t/m 8) eerder op vbNullString gezet ] 90: End With 'Beeindiging macro (resultaat kan positief of negatief zijn, al naargelang of KunmetAnaliz = True ) 'MsgBox "label 90 (einde macro KunmetAnaliz)" End Function Sub ZetSelectieOpZinsWoord(iWoord) ' hulpfunctie voor 'ESPSOF Versio 0.9 24 Majo 2008 TW (Toon Witkam) 'deze routine dient om (vanuit een willekeurige positie in de zin) een bepaald elders in dezelfde zin gelegen Woord... '... te kunnen selecteren; dit geslecteerde woord kan dan vervolgens door het oproepende program gehighlight worden; Dim i As Integer Dim Lengte As Integer Dim iLoop115 As Integer 'cursor terug naar begin zin (naar Field): Lengte = Selection.MoveEndUntil(Cset:=Chr(19), Count:=wdBackward) If ZinBegintMetHaltoStreko Then iWoord = iWoord + 1 '[24-5-08] 'Bij eerste Woord van zin: If iWoord = 1 Then 'hiermee wordt voorkomen dat de Field-code wordt meegeselecteerd en gehighlight: Selection.MoveUp unit:=wdParagraph, Count:=1, Extend:=wdExtend Selection.Collapse direction:=wdCollapseEnd End If For i = 1 To iWoord 115: Lengte = Selection.MoveEndUntil(Cset:=" " & Chr(160) & vbCr & vbTab & vbLf & Chr(11) & Chr(12) & vbCrLf, Count:=wdForward) - 1 'ook Tab, Linefeed, vbCr etc. gelden ALTIJD als woordgrens If Lengte = 1 Then '[24-7-07] 'Tel het optreden van een losstaand leesteken NIET mee in de lus, want de AZM-woordtelling telt dat OOK NIET mee: If Selection.Text = "-" Or Selection.Text = ChrW(150) Or Selection.Text = ChrW(8211) Or Selection.Text = ChrW(8212) Or Selection.Text = "," _ Or Selection.Text = "." Or Selection.Text = ChrW(8230) Then i = i - 1 'het betreft een losstaand streepje of GEDACHTENSTREEP (HaltoStreko),... '...maar ook losstaande komma, losstaande punt (ook als onderdeel van GESPATIEERDE ELLIPSIS), of tripunkto (Unicode 8230) '[30-7-2007] End If If Lengte = 3 Then If Selection.Text = "..." Then i = i - 1 'ellipsis in vorm van 3 aaneengesloten punten ( 3 keer Ascii 46) End If If Lengte = 4 Then If Selection.Text = "...." Then i = i - 1 'ellipsis in vorm van 4 aaneengesloten punten ( 4 keer Ascii 46) End If If Lengte > 0 Then GoTo 120 '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 iLoop115 = iLoop115 + 1 If iLoop115 > 16 Then GoTo 120 '(ter vermijding van evt. endless loop) '[25-7-07] GoTo 115 120: iLoop115 = 0 Next i 'het iWoord in de zin is nu geselecteerd; 'kleine optische onvolkomenheid: ' - bij elk iWoord worden de ervoor of erachter hangende leestekens mee geselecteerd. End Sub Sub AtentigoTrairoFonto1() ' hulpfunctie voor 'ESPSOF Versio 0.9 26 Majo 2008 TW (Toon Witkam) ' [vroegere naam: MsgboxInWORDmacro091 ] 'Voor het plaatsen van een (tijdelijke) Textbox op cursorpositie in de WORD-file: 'Selection.TypeText " " ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 90#, _ 63#, 432#, 90#).Select Selection.ShapeRange.TextFrame.TextRange.Select Selection.Collapse 'Selection.TypeText "ESPSOF nun eklaboras; unue la vortar-dosiero k.s. estas pretigitaj (tio da" & ChrW(365) & "ros 10-15 sekundojn); sekvas anta" & ChrW(365) & "rtrairo de via tekstfonto..." Selection.TypeText "ESPSOF nun eklaboras; sekvas anta" & ChrW(365) & "-trairo de via tekstfonto..." '----[26-1-09, experimenterend:]----- 'Selection.ShapeRange.TextFrame.TextRange.Select 'werkt wel [26-1-09] 'Selection.Copy 'werkt wel [26-1-09] 'Selection.ShapeRange.Delete 'manier om (alle) Text "uit de Box" te krijgen: lijkt te werken [26-1-09] 'Selection.Paste 'werkt wel [26-1-09] 'ActiveDocument.Shapes.Count 'tellen van aantal in doc aanwezige Textboxes werkt nog niet [26-1-09] '-------------- 'Deze tekst komt te voorschijn in een Textbox die tijdelijk in het window van de MS Word brontekstfile verschijnt. 'Hiermee kan met de ESPSOF-gebruiker worden gecommuniceerd op een wijze die de (niet mogelijke) vbModeless variant ... '... van de VBA-Inputbox benadert. Selection.ShapeRange.Select Selection.Font.Color = wdPink Selection.Font.Bold = wdToggle Selection.Font.Size = 18 Selection.Font.Name = "Lucida Console" 'Er zijn talloze verdere vormgevings/kleuringsmogelijkhden, tot en met 3D toe: 'selection.ShapeRange.Line.ForeColor.RGB = RGB(50, 0, 128) 'kleur van grenslijn Textbox 'Selection.ShapeRange.Fill.ForeColor.RGB = .... 'achtergrondkleur Textbox 'Selection.ShapeRange.Shadow.Type = msoShadow6 End Sub Sub AtentigoTrairoFonto2() ' ' hulpfunctie voor 'ESPSOF Versio 0.9 26 Majo 2008 TW (Toon Witkam) ' [vroegere naam: MsgboxInWORDmacro092 ] 'Voor het weer weghalen van de (tijdelijke) Textbox en terugkeer naar ongerepte cursorpositie in de WORD-file: Selection.ShapeRange.Delete 'Selection.Delete 'unit:=wdCharacter, Count:=1 'deze twee stmts halen de hele Textbox weg, en herstellen oorspronkelijke WORD-file End Sub