'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
'################################################################################