'MacroName:Latin2Armenian 'MacroDescription:Automatically untransliterate a field with Latin characters into Armenian characters 'Macro created by: Joel Hahn, Niles Public Library District 'Macro last modified: 22 November 2013 Option Explicit Option Compare Binary Declare Function TransArmenian(sField As String) As String Sub Main Dim sField As String Dim bool As Integer Dim sTranslit As String Dim i As Integer Dim CharacterSet As Integer Dim sLang As String Dim CS As Object Set CS = CreateObject("Connex.Client") ' Select Case CS.ItemType ' Case -1, 5 To 13, 15 To 16, 21 To 25 ' MsgBox "Not viewing a MARC record. Exiting..." ' Exit Sub ' End Select bool = CS.GetFieldLine(CS.CursorRow, sField) If InStr(sField, "Data contains non-latin script") Then MsgBox "The selected field already contains vernacular data. Exiting..." Exit Sub ElseIf sField = Chr(252) & Chr(252) & Chr(252) & " " Or Trim(Mid(sField, 6)) = "" Then MsgBox "The selected field contains no data. Exiting..." Exit Sub End If For i = 1 to 5 If Asc(Mid(sField, i, 1)) = 252 Then sTranslit = sTranslit & "∎" Else sTranslit = sTranslit & Mid(sField, i, 1) End If Next sTranslit = sTranslit & TransArmenian(sField) bool = CS.AddFieldLine(CS.CursorRow, sTranslit) CS.SendKeys "%ekl", -1 End Sub '################################################################################ Function TransArmenian(sField As String) As String Dim i As Long Dim sNewField As String Dim sTempTranslit As String sNewField = "" sTempTranslit = "" i = 6 Do If Mid(sField, i, 1) = Chr(223) Then sNewField = sNewField & "ǂ" & Mid(sField, i+1, 1) i = i + 2 Else If InStr(" !@#$%^&*()[]{};:.,/?\=+-'" & Chr(34), Mid(sField, i, 1)) Then If Mid(sField, i, 1) <> Chr(223) And Mid(sField, i+1, 2) <> " " & Chr(223) Then If Mid(sField, i, 1) = "'" Then sNewField = sNewField & "՚" ElseIf Mid(sField, i, 1) = "!" Then sNewField = sNewField & "՜" ElseIf Mid(sField, i, 1) = "," Then If Left(sField, 3) Like "[1678]00" Then sNewField = sNewField & Mid(sField, i, 1) ElseIf Left(sField, 3) = "245" and InStr(i, sField, Chr(223)) Then sNewField = sNewField & Mid(sField, i, 1) Else sNewField = sNewField & "՝" End If ElseIf Mid(sField, i, 1) = "?" Then sNewField = sNewField & "՞" 'ElseIf Mid(sField, i, 1) = "." Then ' If i = Len(sField) Then ' sNewField = sNewField & Mid(sField, i, 1) ' ElseIf Mid(sField, i, 2) Like " [A-Za-z0-9]" Then ' sNewField = sNewField & "՚" ' Else ' sNewField = sNewField & "։" ' End If ElseIf Mid(sField, i, 1) = "-" Then sNewField = sNewField & "֊" ElseIf Mid(sField, i, 6) = "[dram]" Then sNewField = sNewField & "֏" Else sNewField = sNewField & Mid(sField, i, 1) End If Else sNewField = sNewField & Mid(sField, i, 1) End If ElseIf InStr("0123456789", Mid(sField, i, 1)) Then sNewField = sNewField & Mid(sField, i, 1) '### Uppercase ElseIf Mid(sField, i, 1) = "A" Then sNewField = sNewField & "Ա" ElseIf Mid(sField, i, 1) = "B" Then sNewField = sNewField & "Բ" ElseIf Mid(sField, i, 1) = "G" Then sTempTranslit = "Գ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "H" Then sTempTranslit = sTempTranslit & "Հ" i = i + 2 ElseIf Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "Ղ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "D" Then sTempTranslit = "Դ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "Z" Then sTempTranslit = sTempTranslit & "Զ" i = i + 2 ElseIf Mid(sField, i+2, 1) = "z" Then sTempTranslit = sTempTranslit & "զ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "z" Then sTempTranslit = "Ձ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "E" Then If Mid(sField, i+1, 1) = Chr(229) Then 'E-macron sNewField = sNewField & "Է" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(233) Then 'E-hacek sNewField = sNewField & "Ը" i = i + 1 ElseIf Mid(sField, i+1, 1) = "v" Then sNewField = sNewField & "Եվ" i = i + 1 ElseIf Mid(sField, i+1, 1) = "w" Then sNewField = sNewField & "Եւ" i = i + 1 Else sNewField = sNewField & "Ե" End If ElseIf Mid(sField, i, 1) = "Z" Then sTempTranslit = "Զ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "H" Then sTempTranslit = sTempTranslit & "Հ" i = i + 2 ElseIf Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "Ժ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "T" Then sTempTranslit = "Տ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "S" Then sTempTranslit = sTempTranslit & "Ս" i = i + 2 ElseIf Mid(sField, i+2, 1) = "s" Then sTempTranslit = sTempTranslit & "ս" i = i + 2 End If ElseIf Mid(sField, i+1, 1) = "'" Or Mid(sField, i+1, 1) = Chr(176) Then sTempTranslit = "Թ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "s" Then If Mid(sField, i+2, 1) = "'" or Mid(sField, i+2, 1) = Chr(176) Then sTempTranslit = "Ց" i = i + 2 Else sTempTranslit = "Ծ" i = i + 1 End If End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "I" Then sNewField = sNewField & "Ի" ElseIf Mid(sField, i, 1) = "L" Then sNewField = sNewField & "Լ" ElseIf Mid(sField, i, 1) = "K" Then sTempTranslit = "Կ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "H" Then sTempTranslit = sTempTranslit & "Հ" i = i + 2 ElseIf Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "Խ" i = i + 1 ElseIf Mid(sField, i+1, 1) = "'" Or Mid(sField, i+1, 1) = Chr(176) Then sTempTranslit = "Ք" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "H" Then sNewField = sNewField & "Հ" ElseIf Mid(sField, i, 1) = "C" Then If LCase(Mid(sField, i+1, 1)) = "h" Then If Mid(sField, i+2, 1) = "'" Or Mid(sField, i+2, 1) = Chr(176) Then sTempTranslit = "Չ" i = i + 2 Else sTempTranslit = "Ճ" i = i + 1 End If Else sTempTranslit = "∎" End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "M" Then sNewField = sNewField & "Մ" ElseIf Mid(sField, i, 1) = "Y" Then sNewField = sNewField & "Յ" ElseIf Mid(sField, i, 1) = "N" Then sNewField = sNewField & "Ն" ElseIf Mid(sField, i, 1) = "S" Then sTempTranslit = "Ս" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "H" Then sTempTranslit = sTempTranslit & "Հ" i = i + 2 ElseIf Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "Շ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "O" Then If Mid(sField, i+1, 1) = Chr(229) Then 'O-macron sNewField = sNewField & "Օ" i = i + 1 Else sNewField = sNewField & "Ո" End If ElseIf Mid(sField, i, 1) = "U" Then sNewField = sNewField & "Ու" ElseIf Mid(sField, i, 1) = "P" Then If Mid(sField, i+1, 1) = "'" Or Mid(sField, i+1, 1) = Chr(176) Then sNewField = sNewField & "Փ" i = i + 1 Else sNewField = sNewField & "Պ" End If ElseIf Mid(sField, i, 1) = "J" Then sNewField = sNewField & "Ջ" ElseIf Mid(sField, i, 1) = "R" Then If Mid(sField, i+1, 1) = Chr(242) Then 'R-dot below sNewField = sNewField & "Ռ" i = i + 1 Else sNewField = sNewField & "Ր" End If ElseIf Mid(sField, i, 1) = "V" Then sNewField = sNewField & "Վ" ElseIf Mid(sField, i, 1) = "W" Then sNewField = sNewField & "Ւ" ElseIf Mid(sField, i, 1) = "F" Then sNewField = sNewField & "Ֆ" '### Lowercase ElseIf Mid(sField, i, 1) = "a" Then sNewField = sNewField & "ա" ElseIf Mid(sField, i, 1) = "b" Then sNewField = sNewField & "բ" ElseIf Mid(sField, i, 1) = "g" Then sTempTranslit = "գ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "ղ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "d" Then sTempTranslit = "դ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "z" Then sTempTranslit = sTempTranslit & "զ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "z" Then sTempTranslit = "ձ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "e" Then If Mid(sField, i+1, 1) = Chr(229) Then 'E-macron sNewField = sNewField & "է" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(233) Then 'E-hacek sNewField = sNewField & "ը" i = i + 1 ElseIf Mid(sField, i+1, 1) = "v" Then sNewField = sNewField & "եվ" i = i + 1 ElseIf Mid(sField, i+1, 1) = "w" Then sNewField = sNewField & "եւ" i = i + 1 Else sNewField = sNewField & "ե" End If ElseIf Mid(sField, i, 1) = "z" Then sTempTranslit = "զ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "ժ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "t" Then sTempTranslit = "տ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "s" Then sTempTranslit = sTempTranslit & "ս" i = i + 2 End If ElseIf Mid(sField, i+1, 1) = "'" Or Mid(sField, i+1, 1) = Chr(176) Then sTempTranslit = "թ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "s" Then If Mid(sField, i+2, 1) = "'" or Mid(sField, i+2, 1) = Chr(176) Then sTempTranslit = "ց" i = i + 2 Else sTempTranslit = "ծ" i = i + 1 End If End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "i" Then sNewField = sNewField & "ի" ElseIf Mid(sField, i, 1) = "l" Then sNewField = sNewField & "լ" ElseIf Mid(sField, i, 1) = "k" Then sTempTranslit = "կ" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "խ" i = i + 1 ElseIf Mid(sField, i+1, 1) = "'" or Mid(sField, i+1, 1) = Chr(176) Then sTempTranslit = "ք" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "h" Then sNewField = sNewField & "հ" ElseIf Mid(sField, i, 1) = "c" Then If LCase(Mid(sField, i+1, 1)) = "h" Then If Mid(sField, i+2, 1) = "'" Or Mid(sField, i+2, 1) = Chr(176) Then sTempTranslit = "չ" i = i + 2 Else sTempTranslit = "ճ" i = i + 1 End If Else sTempTranslit = "∎" End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "m" Then sNewField = sNewField & "մ" ElseIf Mid(sField, i, 1) = "y" Then sNewField = sNewField & "յ" ElseIf Mid(sField, i, 1) = "n" Then sNewField = sNewField & "ն" ElseIf Mid(sField, i, 1) = "s" Then sTempTranslit = "ս" If Mid(sField, i+1, 1) = Chr(167) Then If Mid(sField, i+2, 1) = "h" Then sTempTranslit = sTempTranslit & "հ" i = i + 2 End If ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sTempTranslit = "շ" i = i + 1 End If sNewField = sNewField & sTempTranslit ElseIf Mid(sField, i, 1) = "o" Then If Mid(sField, i+1, 1) = Chr(229) Then 'O-macron sNewField = sNewField & "օ" i = i + 1 Else sNewField = sNewField & "ո" End If ElseIf Mid(sField, i, 1) = "u" Then sNewField = sNewField & "ու" ElseIf Mid(sField, i, 1) = "p" Then If Mid(sField, i+1, 1) = "'" Or Mid(sField, i+1, 1) = Chr(176) Then sNewField = sNewField & "փ" i = i + 1 Else sNewField = sNewField & "պ" End If ElseIf Mid(sField, i, 1) = "j" Then sNewField = sNewField & "ջ" ElseIf Mid(sField, i, 1) = "r" Then If Mid(sField, i+1, 1) = Chr(242) Then 'R-dot below sNewField = sNewField & "ռ" i = i + 1 Else sNewField = sNewField & "ր" End If ElseIf Mid(sField, i, 1) = "v" Then sNewField = sNewField & "վ" ElseIf Mid(sField, i, 1) = "w" Then sNewField = sNewField & "ւ" ElseIf Mid(sField, i, 1) = "f" Then sNewField = sNewField & "ֆ" Else sNewField = sNewField & "∎" End If i = i + 1 End If Loop While i <= Len(sField) TransArmenian = sNewField End Function