'MacroName:Armenian2Latin 'MacroDescription:Automatically transliterate a field with Armenian characters into Latin characters 'Macro written by: Joel Hahn, Niles Public Library District 'Macro last modified: 22 November 2013 Declare Function TransArmenian(sChar As String, sNextChar As String, nPos As Variant) As String Declare Function IsArmenChar(sNCR) As Integer Global arrChars() Option Explicit Sub Main Dim bool as Integer Dim sField As String Dim nHasArmen as integer Dim NewField As String Dim i, a Dim sHex As String Dim nHex As Long Dim TempChar As String Dim place3 as Integer Dim place As Integer Dim sBCR As String Dim CS As Object Set CS = CreateObject("Connex.Client") ReDim arrChars(0) bool = CS.GetFieldLineUnicode(CS.CursorRow, sField) NewField = Left(sField, 5) sField = Mid(sField, 6) i = 1 : nHasArmen = 0 Do While i <= Len(sField) - 7 a = Mid(sField, i, 8) If IsArmenChar(Mid(sField, i, 6)) Then nHasArmen = 1 Exit Do End If i = i + 1 Loop If nHasArmen = 0 Then MsgBox "Field contains no Armenian characters. Exiting..." Exit Sub End If 'Break up Armenian field in to separate characters i = 1 Do While i <= Len(sField) ReDim Preserve arrChars(UBound(arrChars) + 1) If Mid(sField, i, 3) = "&#x" Then place = InStr(i, sField, ";") sBCR = Mid(sField, i, (place - i) + 1) arrChars(UBound(arrChars)) = sBCR i = place Else arrChars(UBound(arrChars)) = Mid(sField, i, 1) End If i = i + 1 Loop i = 1 Do While i <= UBound(arrChars) If InStr(arrChars(i), "&#x") Then sHex = Mid(arrChars(i), 4, Len(arrChars(i)) - 2) nHex = Val("&H" & sHex) Select Case nHex Case &H01C2 'Delimiter NewField = NewField & Chr(223) Case &H0530 To &H058F 'Armenian character If i < UBound(arrChars) Then TempChar = TransArmenian(arrChars(i), arrChars(i+1), i) Dim c If TempChar = "O" And arrChars(i+1) = "ւ" Then TempChar = "U" i = i + 1 ElseIf TempChar = "o" And arrChars(i+1) = "ւ" Then TempChar = "u" i = i + 1 End If Else TempChar = TransArmenian(arrChars(i), "&H0000;", i) End If NewField = NewField + TempChar Case &HFB13 To &HFB17 'Armenian ligature--not valid in Connexion, but might still be present TempChar = TransArmenian(arrChars(i), arrChars(i+1), i) NewField = NewField + TempChar Case Else 'Non-Armenian Unicode character NewField = NewField & Chr(252) End Select Else If arrChars(i) = Chr(171) or arrChars(i) = Chr(187) Then 'Convert angle-quotation marks; assume plus/minus sign is actually an angle-quotation mark, due to using the same ASCII code point NewField = NewField & Chr(34) ElseIf arrChars(i) = "~" Then NewField = NewField & "!" Else NewField = NewField & arrChars(i) End If End If i = i + 1 Loop bool = CS.AddFieldLine(CS.CursorRow + 1, NewField) CS.CursorRow = CS.CursorRow -1 CS.SendKeys "%ekl", -1 End Sub '############################################################################## Function IsArmenChar(sNCR) As Integer Dim b b = Mid(sNCR, 1, 6) If Len(sNCR) = 6 And ((Mid(sNCR, 1, 6) Like "&[#]x05[3-8]") Or (Mid(sNCR, 1, 7) Like "&[#]xFB1")) Then IsArmenChar = 1 Else IsArmenChar = 0 End If End Function Function TransArmenian(sChar As String, sNextChar As String, nPos As Variant) As String Dim sHex As String Dim nHex As Integer Dim TempTranslit As String Dim sNextHex As String Dim nNextHex As Long sHex = Mid(sChar, 4, Len(sChar) - 2) nHex = Val("&H" & sHex) sNextHex = Mid(sNextChar, 4, Len(sNextChar) - 1) nNextHex = Val("&H" & sNextHex) Select Case nHex Case &H0531 TransArmenian = "A" Case &H0532 TransArmenian = "B" Case &H0533 TransArmenian = "G" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "G" & Chr(167) 'G-prime End If Case &H0534 TransArmenian = "D" If nNextHex = &H0536 or nNextHex = &H0566 Then TransArmenian = "D" & Chr(167) 'D-prime End If Case &H0535 TransArmenian = "E" If sNextChar = "." Then TransArmenian = "Y" End If Case &H0536 TransArmenian = "Z" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "Z" & Chr(167) 'Z-prime End If Case &H0537 TransArmenian = "E" & Chr(229) 'E-macron Case &H0538 TransArmenian = "E" & Chr(233) 'E-hacek Case &H0539 TransArmenian = "T" & Chr(176) 'T-ayin Case &H053A TransArmenian = "Zh" Case &H053B TransArmenian = "I" Case &H053C TransArmenian = "L" Case &H053D TransArmenian = "Kh" Case &H053E TransArmenian = "Ts" Case &H053F TransArmenian = "K" Case &H0540 TransArmenian = "H" Case &H0541 TransArmenian = "Dz" Case &H0542 TransArmenian = "Gh" Case &H0543 TransArmenian = "Ch" Case &H0544 TransArmenian = "M" Case &H0545 TransArmenian = "Y" If sNextChar = "." Then TransArmenian = "H" End If Case &H0546 TransArmenian = "N" Case &H0547 TransArmenian = "Sh" Case &H0548 TransArmenian = "O" Case &H0549 TransArmenian = "Ch" & Chr(176) 'Ch-ayin Case &H054A TransArmenian = "P" Case &H054B TransArmenian = "J" Case &H054C TransArmenian = "R" & Chr(242) 'R-dot below Case &H054D TransArmenian = "S" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "S" & Chr(167) 'S-prime End If Case &H054E TransArmenian = "V" Case &H054F TransArmenian = "T" If nNextHex = &H054D or nNextHex = &H057D Then TransArmenian = "T" & Chr(167) 'T-prime End If Case &H0550 TransArmenian = "R" Case &H0551 TransArmenian = "Ts" & Chr(176) 'Ts-ayin Case &H0552 TransArmenian = "W" Case &H0553 TransArmenian = "P" & Chr(176) 'P-ayin Case &H0554 TransArmenian = "K" & Chr(176) 'K-ayin Case &H0555 TransArmenian = "O" & Chr(229) 'O-macron Case &H0556 TransArmenian = "F" Case &H0561 TransArmenian = "a" Case &H0562 TransArmenian = "b" Case &H0563 TransArmenian = "g" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "g" & Chr(167) 'g-prime End If Case &H0564 TransArmenian = "d" If nNextHex = &H0536 or nNextHex = &H0566 Then TransArmenian = "d" & Chr(167) 'd-prime End If Case &H0565 TransArmenian = "e" 'If nNextHex = "." Then ' TransArmenian = "y" 'End If Case &H0566 TransArmenian = "z" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "z" & Chr(167) 'z-prime End If Case &H0567 TransArmenian = "e" & Chr(229) 'e-macron Case &H0568 TransArmenian = "e" & Chr(233) 'e-hacek Case &H0569 TransArmenian = "t" & Chr(176) 't-ayin Case &H056A TransArmenian = "zh" Case &H056B TransArmenian = "i" Case &H056C TransArmenian = "l" Case &H056D TransArmenian = "kh" Case &H056E TransArmenian = "ts" Case &H056F TransArmenian = "k" Case &H0570 TransArmenian = "h" Case &H0571 TransArmenian = "dz" Case &H0572 TransArmenian = "gh" Case &H0573 TransArmenian = "ch" Case &H0574 TransArmenian = "m" Case &H0575 TransArmenian = "y" 'If nNextHex = "." Then ' TransArmenian = "h" 'End If Case &H0576 TransArmenian = "n" Case &H0577 TransArmenian = "sh" Case &H0578 TransArmenian = "o" Case &H0579 TransArmenian = "ch" & Chr(176) 'ch-ayin Case &H057A TransArmenian = "p" Case &H057B TransArmenian = "j" Case &H057C TransArmenian = "r" & Chr(242) 'r-dot below Case &H057D TransArmenian = "s" If nNextHex = &H0540 or nNextHex = &H0570 Then TransArmenian = "s" & Chr(167) 's-prime End If Case &H057E TransArmenian = "v" Case &H057F TransArmenian = "t" If nNextHex = &H054D or nNextHex = &H057D Then TransArmenian = "t" & Chr(167) 't-prime End If Case &H0580 TransArmenian = "r" Case &H0581 TransArmenian = "ts" & Chr(176) 'ts-ayin Case &H0582 TransArmenian = "w" Case &H0583 TransArmenian = "p" & Chr(176) 'p-ayin Case &H0584 TransArmenian = "k" & Chr(176) 'k-ayin Case &H0585 TransArmenian = "o" & Chr(229) 'o-macron Case &H0586 TransArmenian = "f" Case &H0587 TransArmenian = "ev" Case &H0559 TransArmenian = Chr(176) 'Left half-ring above (approximately an ayn) Case &H055A TransArmenian = "'" Case &H055B TransArmenian = "" 'Armenian stress mark; not transliterated Case &H055C TransArmenian = "!" Case &H055D TransArmenian = "," Case &H055E TransArmenian = "?" Case &H055F TransArmenian = "." Case &H0589 TransArmenian = "." Case &H058A TransArmenian = "-" Case &H058F TransArmenian = "[dram]" Case &HFB13 TransArmenian = "mn" Case &HFB14 TransArmenian = "me" Case &HFB15 TransArmenian = "mi" Case &HFB16 TransArmenian = "vn" Case &HFB17 TransArmenian = "mkh" Case Else TransArmenian = Chr(252) End Select End Function