'MacroName:Latin2Bengali 'MacroDescription:Automatically untransliterate a field with Latin characters into Bengali or Assamese characters 'Macro created by: Joel Hahn 'Macro last modified: 15 Oct 2016 Option Explicit Option Compare Binary Declare Function TransBengali(sField As String, CharacterSet As Integer) 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 On Error Resume Next Set CS = GetObject(,"Connex.Client") On Error GoTo 0 If CS Is Nothing Then Set CS = CreateObject("Connex.Client") End If ' 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.GetFixedField("Lang", sLang) Select Case sLang Case "ben" CharacterSet = 0 Case "asm" CharacterSet = 1 Case Else 'Set the default transliteration table selection ' 0 = Bengali ' 1 = Assamese CharacterSet = 0 End Select ' Dim CharSets(6) As String ' CharSets(0) = "Bengali" ' CharSets(1) = "Assamese" ' Begin Dialog newdlg 183, 60, "Transliteration Options" ' OkButton 35, 42, 50, 14 ' CancelButton 95, 42, 50, 14 ' Text 3, 3, 177, 10, "Please select the LC Devanagari transliteration table to use:" ' DropListBox 52, 11, 78, 98, CharSets(), .Langs ' End Dialog ' Dim CharSelect As newdlg ' CharSelect.Langs = CharacterSet ' response = Dialog(CharSelect) ' If response = 0 Then ' Exit Sub ' End If ' CharacterSet = CharSelect.Langs 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 'Select Case CharacterSet ' Case 0 sTranslit = sTranslit & TransBengali(sField, CharacterSet) ' Case 1 ' sTranslit = sTranslit & TransMarathi(sField) ' Case 2 ' sTranslit = sTranslit & TransSanskrit(sField) ' Case Else ' Exit Sub ' End Select bool = CS.AddFieldLine(CS.CursorRow, sTranslit) CS.SendKeys "%ekl", -1 End Sub '################################################################################ Function TransBengali(sField As String, CharacterSet As Integer) As String Dim i As Long Dim sCurVowel As Integer Dim sNewField As String sNewField = "" Dim sTransNumbers As String sTransNumbers = "N" 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 sCurVowel = 2 sNewField = sNewField & Mid(sField, i, 1) ElseIf Mid(sField, i, 1) = "'" Then sCurVowel = 2 sNewField = sNewField & "ঽ" ElseIf InStr("0123456789", Mid(sField, i, 1)) Then If sTransNumbers = "N" Then sCurVowel = 2 sNewField = sNewField & Mid(sField, i, 1) Else sCurVowel = 2 If Mid(sField, i, 1) = "0" Then sNewField = sNewField & "০" ElseIf Mid(sField, i, 1) = "1" Then sNewField = sNewField & "১" ElseIf Mid(sField, i, 1) = "2" Then sNewField = sNewField & "২" ElseIf Mid(sField, i, 1) = "3" Then sNewField = sNewField & "৩" ElseIf Mid(sField, i, 1) = "4" Then sNewField = sNewField & "৪" ElseIf Mid(sField, i, 1) = "5" Then sNewField = sNewField & "৫" ElseIf Mid(sField, i, 1) = "6" Then sNewField = sNewField & "৬" ElseIf Mid(sField, i, 1) = "7" Then sNewField = sNewField & "৭" ElseIf Mid(sField, i, 1) = "8" Then sNewField = sNewField & "৮" ElseIf Mid(sField, i, 1) = "9" Then sNewField = sNewField & "৯" End If End If ElseIf UCase(Mid(sField, i, 1)) = "A" Then If i = 6 Or sCurVowel <> 0 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then 'If LCase(Mid(sField, i+1, 2)) = Chr(230) & "i" Then ' sNewField = sNewField & "∎" 'not a valid Unicode character ' i = i + 2 'ElseIf LCase(Mid(sField, i+1, 2)) = Chr(230) & "u" Then ' sNewField = sNewField & "৵" ' i = i + 2 If LCase(Mid(sField, i+1, 2)) = "i" & Chr(229) Then 'just do the A and go on to the next, separate vowel sNewField = sNewField & "অ" ElseIf LCase(Mid(sField, i+1, 1)) = "i" Then sNewField = sNewField & "ঐ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 2)) = "u" & Chr(229) Then 'just do the A and go on to the next, separate vowel sNewField = sNewField & "অ" ElseIf LCase(Mid(sField, i+1, 1)) = "u" Then sNewField = sNewField & "ঔ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "আ" i = i + 1 Else sNewField = sNewField & "অ" End If Else 'If LCase(Mid(sField, i+1, 2)) = Chr(230) & "i" Then ' sNewField = sNewField & "∎" ' i = i + 2 'ElseIf LCase(Mid(sField, i+1, 2)) = Chr(230) & "u" Then ' sNewField = sNewField & "৏" ' i = i + 2 If LCase(Mid(sField, i+1, 2)) = "i" & Chr(229) Then 'skip the a and go to the next, separate vowel ElseIf LCase(Mid(sField, i+1, 1)) = "i" Then sNewField = sNewField & "ৈ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 2)) = "u" & Chr(229) Then 'skip the a and go to the next, separate vowel ElseIf LCase(Mid(sField, i+1, 1)) = "u" Then sNewField = sNewField & "ৌ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "া" i = i + 1 Else 'Implied, not written End If End If sCurVowel = 1 ElseIf UCase(Mid(sField, i, 1)) = "E" Then If i = 6 Or sCurVowel <> 0 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then If Mid(sField, i+1, 1) = Chr(230) Then sNewField = sNewField & "঄" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(227) Then sNewField = sNewField & "৲" i = i + 1 Else sNewField = sNewField & "এ" End If Else If Mid(sField, i+1, 1) = Chr(230) Then sNewField = sNewField & "∎" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(227) Then sNewField = sNewField & "∎" i = i + 1 Else sNewField = sNewField & "ে" End If End If sCurVowel = 1 ElseIf UCase(Mid(sField, i, 1)) = "I" Then If i = 6 Or sCurVowel <> 0 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then If Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "ঈ" i = i + 1 Else sNewField = sNewField & "ই" End If Else If Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "ী" i = i + 1 Else sNewField = sNewField & "ি" End If End If sCurVowel = 1 ElseIf UCase(Mid(sField, i, 1)) = "O" Then If i = 6 Or sCurVowel <> 0 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then If Mid(sField, i+1, 1) = Chr(230) Then sNewField = sNewField & "঒" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(227) Then sNewField = sNewField & "঑" i = i + 1 Else sNewField = sNewField & "ও" End If Else If Mid(sField, i+1, 1) = Chr(230) Then sNewField = sNewField & "৊" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(227) Then sNewField = sNewField & "৉" i = i + 1 Else sNewField = sNewField & "ো" End If End If sCurVowel = 1 ElseIf UCase(Mid(sField, i, 1)) = "U" Then If i = 6 Or sCurVowel <> 0 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then If Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "ঊ" i = i + 1 Else sNewField = sNewField & "উ" End If Else If Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "ূ" i = i + 1 Else sNewField = sNewField & "ু" End If End If sCurVowel = 1 ElseIf UCase(Mid(sField, i, 1)) = "K" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 3)) = Chr(246) & "h" & Chr(246) Then sNewField = sNewField & "খ়" i = i + 3 ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "খ" i = i + 1 Else sNewField = sNewField & "ক" End If ElseIf UCase(Mid(sField, i, 1)) = "Q" Then sCurVowel = 0 sNewField = sNewField & "ক়" ElseIf UCase(Mid(sField, i, 1)) = "G" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 3)) = Chr(246) & "h" & Chr(246) Then sNewField = sNewField & "গ়" i = i + 3 ElseIf LCase(Mid(sField, i+1, 3)) = Chr(245) & "h" & Chr(245) Then sNewField = sNewField & "ঘ়" i = i + 3 ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ঘ" i = i + 1 Else sNewField = sNewField & "গ" End If ElseIf UCase(Mid(sField, i, 1)) = "C" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ছ" i = i + 1 Else sNewField = sNewField & "চ" End If ElseIf UCase(Mid(sField, i, 1)) = "J" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ঝ" i = i + 1 Else sNewField = sNewField & "জ" End If ElseIf UCase(Mid(sField, i, 1)) = "Z" Then sCurVowel = 0 sNewField = sNewField & "জ়" ElseIf UCase(Mid(sField, i, 1)) = "T" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 2)) = Chr(242) & "h" Then sNewField = sNewField & "ঠ" i = i + 2 ElseIf Mid(sField, i+1, 1) = Chr(242) Then sNewField = sNewField & "ট" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(243) Then sNewField = sNewField & "ট়" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(246) Then sCurVowel = 2 'Special character, never followed by a vowel sNewField = sNewField & "ৎ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "থ" i = i + 1 Else sNewField = sNewField & "ত" End If ElseIf UCase(Mid(sField, i, 1)) = "D" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 2)) = Chr(242) & "h" Then sNewField = sNewField & "ঢ" i = i + 2 ElseIf Mid(sField, i+1, 1) = Chr(242) Then sNewField = sNewField & "ড" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ধ" i = i + 1 Else sNewField = sNewField & "দ" End If ElseIf UCase(Mid(sField, i, 1)) = "P" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ফ" i = i + 1 Else sNewField = sNewField & "প" End If ElseIf UCase(Mid(sField, i, 1)) = "F" Then sCurVowel = 0 sNewField = sNewField & "ফ়" ElseIf UCase(Mid(sField, i, 1)) = "B" Then sCurVowel = 0 If LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ভ" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "b" and CharacterSet = 0 Then sNewField = sNewField & "বব" i = i + 1 Else sNewField = sNewField & "ব" End If ElseIf UCase(Mid(sField, i, 1)) = "Y" Then sCurVowel = 0 If Mid(sField, i+1, 1) = Chr(231) Then sNewField = sNewField & "য়" i = i + 1 Else sNewField = sNewField & "য" End If ElseIf UCase(Mid(sField, i, 1)) = "V" and CharacterSet = 0 Then sCurVowel = 0 sNewField = sNewField & "ব" '"঵" ElseIf UCase(Mid(sField, i, 1)) = "W" and CharacterSet = 1 Then sCurVowel = 0 sNewField = sNewField & "ৱ" ElseIf UCase(Mid(sField, i, 1)) = "S" Then sCurVowel = 0 If Mid(sField, i+1, 1) = Chr(226) Then sNewField = sNewField & "শ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(243) Then sNewField = sNewField & "স়" i = i + 1 ElseIf LCase(Mid(sField, i+1, 1)) = "h" Then sNewField = sNewField & "ষ" i = i + 1 Else sNewField = sNewField & "স" End If ElseIf UCase(Mid(sField, i, 1)) = "H" Then sCurVowel = 0 If Mid(sField, i+1, 1) = Chr(242) Then sCurVowel = 2 sNewField = sNewField & "ঃ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(243) Then sNewField = sNewField & "হ়" i = i + 1 Else sNewField = sNewField & "হ" End If ElseIf UCase(Mid(sField, i, 1)) = "R" Then If Mid(sField, i+1, 2) = Chr(244) & Chr(229) Or Mid(sField, i+1, 2) = Chr(229) & Chr(244) Then sCurVowel = 1 If i = 6 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then sNewField = sNewField & "ৠ" Else sNewField = sNewField & "ৄ" End If i = i + 2 ElseIf Mid(sField, i+1, 1) = Chr(244) Then sCurVowel = 1 If i = 6 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then sNewField = sNewField & "ঋ" Else sNewField = sNewField & "ৃ" End If i = i + 1 ElseIf LCase(Mid(sField, i+1, 2)) = Chr(242) & "h" Then sCurVowel = 0 sNewField = sNewField & "ঢ়" i = i + 2 ElseIf Mid(sField, i+1, 1) = Chr(242) Then sCurVowel = 0 sNewField = sNewField & "ড়" i = i + 1 Else sCurVowel = 0 If CharacterSet = 1 Then sNewField = sNewField & "ৰ" Else 'CharacterSet = 0 sNewField = sNewField & "র" End If End If ElseIf UCase(Mid(sField, i, 1)) = "L" Then If Mid(sField, i+1, 1) = Chr(244) Then sCurVowel = 1 If i = 6 Or Not (Right(sNewField, 2) Like "[0-9A-F];") Then sNewField = sNewField & "ঌ" Else sNewField = sNewField & "ৢ" End If i = i + 1 Else sCurVowel = 0 sNewField = sNewField & "ল" End If ElseIf UCase(Mid(sField, i, 1)) = "M" Then sCurVowel = 0 If Mid(sField, i+1, 1) = Chr(242) Then sNewField = sNewField & "ং" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(239) Then sNewField = sNewField & "ঁ" i = i + 1 Else 'If InStr( "[pfbm 0123456789!@#$%^&*()[]{};:.,/?\=+-]", LCase(Mid(sField, i+1, 1)) ) Then ' sNewField = sNewField & "ং" 'Else sNewField = sNewField & "ম" 'End If End If If Right(sNewField, 8) = "ং" Or Right(sNewField, 8) = "ঁ" Then sCurVowel = 2 Else sCurVowel = 0 ElseIf UCase(Mid(sField, i, 1)) = "N" Then If Mid(sField, i+1, 1) = Chr(242) Then If LCase(Mid(sField, i+2, 2)) = "d" & Chr(242) Or LCase(Mid(sField, i+2, 2)) = "n" & Chr(242) Or LCase(Mid(sField, i+2, 2)) = "r" & Chr(242) Or LCase(Mid(sField, i+2, 2)) = "t" & Chr(242) Then sNewField = sNewField & "ং" Else sNewField = sNewField & "ণ" End If i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(228) Then sNewField = sNewField & "ঞ" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(231) Then 'If Mid(sField, i+2, 1) Like "[gkq]" Or LCase(Mid(sField, i+2, 2)) = "n" & Chr(231) Then ' sNewField = sNewField & "ং" 'Else sNewField = sNewField & "ঙ" 'End If i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(229) Then sNewField = sNewField & "ং" i = i + 1 ElseIf Mid(sField, i+1, 1) = Chr(239) Then sNewField = sNewField & "ঁ" i = i + 1 Else 'If Mid(sField, i+1, 1) Like "[tdn]" Then ' sNewField = sNewField & "ং" 'Else sNewField = sNewField & "ন" 'End If End If If Right(sNewField, 8) = "ং" Or Right(sNewField, 8) = "ঁ" Then sCurVowel = 2 Else sCurVowel = 0 Else sNewField = sNewField & "∎" End If i = i + 1 End If If sCurVowel = 0 And Not ( Right(sNewField, 1) Like "[0-9a-z ]" Or Mid(sField, i, 1) Like "[0-9AEIOUaeiou]" Or LCase(Mid(sField, i, 2)) = "r" & Chr(244) Or LCase(Mid(sField, i, 2)) = "l" & Chr(244) ) Then sNewField = sNewField & "্" End If Loop While i <= Len(sField) TransBengali = sNewField End Function '################################################################################