'MacroName:Latin2Georgian 'MacroDescription:Automatically untransliterate a field with Latin characters into Georgian characters 'Macro created by: Joel Hahn 'Macro last modified: 16 October 2015 Option Explicit Option Compare Binary Declare Function TransGeorgian(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 & TransGeorgian(sField) bool = CS.AddFieldLine(CS.CursorRow, sTranslit) CS.SendKeys "%ekl", -1 End Sub '################################################################################ Function TransGeorgian(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 sNewField = sNewField & Mid(sField, i, 1) 'End If ElseIf InStr("0123456789", Mid(sField, i, 1)) Then sNewField = sNewField & Mid(sField, i, 1) ElseIf Mid(sField, i, 1) = Chr(176) Or Mid(sField, i, 1) = Chr(167) Or Mid(sField, i, 1) = "'" Then 'Ayn or apostrophe sNewField = sNewField & "ჸ" ElseIf LCase(Mid(sField, i, 1)) = "a" Then sNewField = sNewField & "ა" ElseIf LCase(Mid(sField, i, 1)) = "b" Then sNewField = sNewField & "ბ" ElseIf LCase(Mid(sField, i, 1)) = "g" Then If Mid(sField, i+1, 1) = Chr(231) Then 'G-superior dot sNewField = sNewField & "ღ" i = i + 1 Else sNewField = sNewField & "გ" End If sNewField = sNewField & sTempTranslit ElseIf LCase(Mid(sField, i, 1)) = "d" Then sNewField = sNewField & "დ" ElseIf LCase(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(230) Then 'E-breve sNewField = sNewField & "ჷ" i = i + 1 Else sNewField = sNewField & "ე" End If ElseIf LCase(Mid(sField, i, 1)) = "v" Then sNewField = sNewField & "ვ" ElseIf LCase(Mid(sField, i, 1)) = "z" Then If Mid(sField, i+1, 1) = Chr(233) Then 'z-hacek sNewField = sNewField & "ჟ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(231) Then 'z-superior dot sNewField = sNewField & "ძ" i = i + 1 Else sNewField = sNewField & "ზ" End If ElseIf LCase(Mid(sField, i, 1)) = "i" Then sNewField = sNewField & "ი" ElseIf LCase(Mid(sField, i, 1)) = "k" Then If Mid(sField, i+1, 1) = Chr(176) Or Mid(sField, i+1, 1) = Chr(167) Or Mid(sField, i+1, 1) = "'" Then 'k-ayn or k-apostrophe sNewField = sNewField & "ქ" i = i + 1 Else sNewField = sNewField & "კ" End If ElseIf LCase(Mid(sField, i, 1)) = "l" Then sNewField = sNewField & "ლ" ElseIf LCase(Mid(sField, i, 1)) = "m" Then sNewField = sNewField & "მ" ElseIf LCase(Mid(sField, i, 1)) = "n" Then sNewField = sNewField & "ნ" ElseIf LCase(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 LCase(Mid(sField, i, 1)) = "p" Then If Mid(sField, i+1, 1) = Chr(176) Or Mid(sField, i+1, 1) = Chr(167) Or Mid(sField, i+1, 1) = "'" Then 'p-ayn or p-apostrophe sNewField = sNewField & "ფ" i = i + 1 Else sNewField = sNewField & "პ" End If ElseIf LCase(Mid(sField, i, 1)) = "q" Then sNewField = sNewField & "ყ" ElseIf LCase(Mid(sField, i, 1)) = "r" Then sNewField = sNewField & "რ" ElseIf LCase(Mid(sField, i, 1)) = "s" Then If Mid(sField, i+1, 1) = Chr(233) Then 's-hacek sNewField = sNewField & "შ" i = i + 1 Else sNewField = sNewField & "ს" End If ElseIf LCase(Mid(sField, i, 1)) = "t" Then If Mid(sField, i+1, 1) = Chr(176) Or Mid(sField, i+1, 1) = Chr(167) Or Mid(sField, i+1, 1) = "'" Then 't-ayn or t-apostrophe sNewField = sNewField & "თ" i = i + 1 Else sNewField = sNewField & "ტ" End If ElseIf LCase(Mid(sField, i, 1)) = "u" Then If Mid(sField, i+1, 1) = Chr(230) Then 'u-breve sNewField = sNewField & "უ̌" i = i + 1 Else sNewField = sNewField & "უ" End If ElseIf Mid(sField, i, 1) = "c" Then If Mid(sField, i+1, 2) = Chr(176) & Chr(233) Or Mid(sField, i+1, 2) = Chr(233) & Chr(176) Or Mid(sField, i+1, 2) = Chr(167) & Chr(233) Or Mid(sField, i+1, 2) = Chr(233) & Chr(167) Or Mid(sField, i+1, 2) = Chr(233) & "'" Then 'c-ayn-hacek, c-hacek-ayn, or c-hacek-apostrophe sNewField = sNewField & "ჩ" i = i + 2 ElseIf Mid(sField, i+1, 1) = Chr(176) Or Mid(sField, i+1, 1) = Chr(167) Or Mid(sField, i+1, 1) = "'" Then 'c-ayn or c-apostrophe sNewField = sNewField & "ც" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(233) Then 'c-hacek sNewField = sNewField & "ჭ" i = i + 1 Else sNewField = sNewField & "წ" End If ElseIf Mid(sField, i, 1) = "x" Then If Mid(sField, i+1, 1) = Chr(242) Then 'x-dot below sNewField = sNewField & "ჴ" i = i + 1 Else sNewField = sNewField & "ხ" End If ElseIf Mid(sField, i, 1) = "j" Then sNewField = sNewField & "ჯ" ElseIf Mid(sField, i, 1) = "h" Then sNewField = sNewField & "ჰ" ElseIf Mid(sField, i, 1) = "y" 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) TransGeorgian = sNewField End Function