'MacroName:Greek2Latin
'MacroDescription:Automatically transliterate a field with Greek characters into Latin characters
'Macro written by: Joel Hahn, Niles Public Library District
'Macro last modified: 3 October 2021

Declare Function TransGreek(sChar As String, sNextChar As String, nPos As Variant) As String
Declare Function TransGreekAlphaNumbers (nStart As Integer, nEnd As Integer, nNumberSign As Long) As String
Declare Function IsGreekChar(sNCR) As Integer

Global arrChars() As Variant
Option Explicit


Sub Main
   Dim bool as Integer
   Dim sField As String
   Dim CharacterSet As Integer
   Dim nHasGreek as integer
   Dim sLang As String
   Dim NewField As String
   Dim i, j, a
   Dim response As Integer
   Dim sHex As String
   Dim nHex As Long
   Dim TempChar As String
   Dim place3 as Integer
   Dim place As Integer
   Dim sBCR As String

'Set the default transliteration table selection
CharacterSet = 0 'Modern Greek
' 0 = Modern Greek
' 1 = Classical Greek

   Dim CS As Object
   Set CS = CreateObject("Connex.Client")
   ReDim arrChars(0)

   Select Case CS.ItemType
     Case -1, 5 To 13, 15 To 16, 21 To 25
       MsgBox "Not viewing a MARC record. Exiting..." & CStr(CS.ItemType)
       Exit Sub
   End Select

   Dim CharSets(2) As String
   CharSets(0) = "Modern Greek"
   CharSets(1) = "Classical Greek"


    bool = CS.GetFixedField("Lang", sLang)
    Select Case sLang
      Case "gre" 
        CharacterSet = 0
      Case "grc"
        CharacterSet = 1
      Case Else

   Begin Dialog newdlg 183, 50, "Transliteration Options"
      OkButton  35, 27, 50, 14
      CancelButton  95, 27, 50, 14
      Text  3, 3, 177, 10, "Please select the LC Greek transliteration table to use:"
      DropListBox  42, 11, 98, 42, 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   
      End Select

   bool = CS.GetFieldLineUnicode(CS.CursorRow, sField)

   NewField = Left(sField, 5)
   sField = Mid(sField, 6)

   i = 1 : nHasGreek = 0
   Do While i <= Len(sField) - 7
     a = Mid(sField, i, 8)
     If IsGreekChar(Mid(sField, i, 6)) Then
       nHasGreek = 1
       Exit Do
     End If
     i = i + 1
   Loop
   If nHasGreek = 0 Then
      MsgBox "Field contains no Greek characters. Exiting..."
      Exit Sub
   End If

   'Break up vernacular field into 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 &H0370 To &H03FF, &H0314   'Greek character
               If i < UBound(arrChars) Then
                  TempChar = TransGreek(arrChars(i), arrChars(i+1), i)

                  If CharacterSet = 1 And TempChar = "V" Then
                     TempChar = "B"
                  ElseIf CharacterSet = 1 And TempChar = "v" Then
                     TempChar = "b"
                  ElseIf arrChars(i) = "&#x0314;" Then 'combining turned comma above
                     If LCase(Right(NewField, 1)) = "r" Then
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "H"
                        Else
                          TempChar = "h"
                        End If
                     ElseIf Right(NewField, 2) = "AE" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HAE"
                     ElseIf Right(NewField, 2) = "Ae" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hae"
                     ElseIf Right(NewField, 2) = "AI" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HAI"
                     ElseIf Right(NewField, 2) = "Ai" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hai"
                     ElseIf Right(NewField, 3) = "E" & Chr(229) & "U" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "HE" & Chr(229) & "U"
                     ElseIf Right(NewField, 3) = "E" & Chr(229) & "u" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "He" & Chr(229) & "u"
                     ElseIf Right(NewField, 3) = "OE" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "HOE" & Chr(229)
                     ElseIf Right(NewField, 3) = "Oe" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "Hoe" & Chr(229)
                     ElseIf Right(NewField, 2) = "E" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HE" & Chr(229)
                        Else
                          TempChar = "He" & Chr(229)
                        End If
                     ElseIf Right(NewField, 2) = "EU" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HEU"
                     ElseIf Right(NewField, 2) = "Eu" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Heu"
                     ElseIf Right(NewField, 3) = "O" & Chr(229) & "U" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "HO" & Chr(229) & "U"
                     ElseIf Right(NewField, 3) = "O" & Chr(229) & "u" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "Ho" & Chr(229) & "u"
                     ElseIf Right(NewField, 2) = "O" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HO" & Chr(229)
                        Else
                          TempChar = "Ho" & Chr(229)
                        End If
                     ElseIf Right(NewField, 2) = "OE" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HOE"
                     ElseIf Right(NewField, 2) = "Oe" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hoe"
                     ElseIf Right(NewField, 2) = "OI" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HOI"
                     ElseIf Right(NewField, 2) = "Oi" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hoi"
                     ElseIf Right(NewField, 2) = "OU" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HOU"
                     ElseIf Right(NewField, 2) = "Ou" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hou"
                     ElseIf Right(NewField, 2) = "UI" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "HUI"
                     ElseIf Right(NewField, 2) = "Ui" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "Hui"
                     ElseIf Right(NewField, 1) = "A" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HA"
                        Else
                          TempChar = "Ha"
                        End If
                     ElseIf Right(NewField, 1) = "E" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HE"
                        Else
                          TempChar = "He"
                        End If
                     ElseIf Right(NewField, 1) = "I" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "Hi"
                        Else
                          TempChar = "Hi"
                        End If
                     ElseIf Right(NewField, 1) = "O" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HO"
                        Else
                          TempChar = "Ho"
                        End If
                     ElseIf Right(NewField, 1) = "Y" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        If arrChars(i+1) Like "[A-Z]" Then
                          TempChar = "HY"
                        Else
                          TempChar = "Hy"
                        End If
                     ElseIf Right(NewField, 2) = "ae" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hae"
                     ElseIf Right(NewField, 2) = "ai" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hai"
                     ElseIf Right(NewField, 3) = "e" & Chr(229) & "u" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "he" & Chr(229) & "u"
                     ElseIf Right(NewField, 3) = "oe" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "hoe" & Chr(229)
                     ElseIf Right(NewField, 2) = "e" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "he" & Chr(229)
                     ElseIf Right(NewField, 2) = "eu" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "heu"
                     ElseIf Right(NewField, 3) = "o" & Chr(229) & "u" Then
                        NewField = Left(NewField, Len(NewField) - 3)
                        TempChar = "ho" & Chr(229) & "u"
                     ElseIf Right(NewField, 2) = "o" & Chr(229) Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "ho" & Chr(229)
                     ElseIf Right(NewField, 2) = "oe" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hoe"
                     ElseIf Right(NewField, 2) = "oi" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hoi"
                     ElseIf Right(NewField, 2) = "ou" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hou"
                     ElseIf Right(NewField, 2) = "ui" Then
                        NewField = Left(NewField, Len(NewField) - 2)
                        TempChar = "hui"
                     ElseIf Right(NewField, 1) = "a" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        TempChar = "ha"
                     ElseIf Right(NewField, 1) = "e" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        TempChar = "he"
                     ElseIf Right(NewField, 1) = "i" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        TempChar = "hi"
                     ElseIf Right(NewField, 1) = "o" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        TempChar = "ho"
                     ElseIf Right(NewField, 1) = "y" Then
                        NewField = Left(NewField, Len(NewField) - 1)
                        TempChar = "hy"
                     End If
                     'If arrChars(i+1) = "&#x03A1;" Then
                     '  TempChar = "Rh"
                     '  i = i + 1
                     'ElseIf arrChars(i+1) = "&#x03C1;" Then
                     '  TempChar = "rh"
                     '  i = i + 1
                     'ElseIf Right(NewField, 1) Like "[A-Za-z]" Then
                     '  TempChar = "h"
                     'Else
                     '  TempChar = "H"
                     'End If
                  ElseIf TempChar = "g" Then
                     If arrChars(i+1) = "&#x03B3;" Then
                       TempChar = "ng"
                       i = i + 1
                     ElseIf arrChars(i+1) = "&#x03BA;" And (Right(NewField, 1) Like "[A-Za-z]" And Left(arrChars(i+1), 1) Like "[A-Za-z]")  Then 'medial
                       TempChar = "nk"
                       i = i + 1
                     ElseIf arrChars(i+1) = "&#x03BA;" Then 'initial or final
                       TempChar = "gk"
                       i = i + 1
                     ElseIf arrChars(i+1) = "&#x03BE;" Then 
                       TempChar = "nx"
                       i = i + 1
                     ElseIf arrChars(i+1) = "&#x03C7;" Then
                       TempChar = "nch"
                       i = i + 1
                     End If
                  ElseIf TempChar = "M" And Right(NewField, 1) = " " And arrChars(i+1) = "&#x03C0;" Then 'initial
                     TempChar = "B"
                     i = i + 1
                  ElseIf TempChar = "m" And Right(NewField, 1) = " " And arrChars(i+1) = "&#x03C0;" Then 'initial
                     TempChar = "b"
                     i = i + 1
                  ElseIf TempChar = "N" And Right(NewField, 1) = " " And arrChars(i+1) = "&#x03C4;" Then 'initial
                     TempChar = "D" & Chr(246) 'd-underline
                     i = i + 1
                  ElseIf TempChar = "n" And Right(NewField, 1) = " " And arrChars(i+1) = "&#x03C4;" Then 'initial
                     TempChar = "d" & Chr(246) 'd-underline
                     i = i + 1
                  ElseIf TempChar = "y" And InStr("aeio", Right(NewField, 1)) Then
                     TempChar = "u"
                  ElseIf nHex = &H0374 Then 'preceding word was a number
                     'find the preceding word
                     j = i - 1
                     Do Until j < 1
                       If Not arrChars(j) Like "[&$x;0-9A-Fa-f]*" Then
                         Exit Do
                       End If
                       j = j - 1
                     Loop
                     'transform it into digits
                     If j < i - 1 Then
                        TempChar = TransGreekAlphaNumbers(j+1, i-1, nHex)
                     Else
                       TempChar = ""
                     End If
                     'remove the text mistakenly transliterated as letters
                     j = Len(NewField)
                     Do Until j < 6
                       If Not Mid(NewField, j, 1) Like "[A-Za-z0-9]" Then
                         Exit Do
                       End If
                       j = j - 1
                     Loop
                     if j = 5 Then j = 6
                     NewField = Left(NewField, j)
                  ElseIf nHex = &H0375 Then 'following word is a number
                     j = i + 1
                     Do Until j >= UBound(arrChars)
                       If Not arrChars(j) Like "[&$x;0-9A-Fa-f]*" Then
                         Exit Do
                       End If
                       j = j + 1
                     Loop
                     If j > i + 1 <> "" Then
                        TempChar = TransGreekAlphaNumbers(i+1, j-1, nHex)
                     Else
                       TempChar = ""
                     End If
                     i = i + (j - i) - 1

                  End If
               Else
                  TempChar = TransGreek(arrChars(i), "&H0000;", i)
               End If
               NewField = NewField + TempChar
            Case Else   'Non-Greek 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)
         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 IsGreekChar(sNCR) As Integer
   Dim b
   b = Mid(sNCR, 1, 6)
   If Len(sNCR) = 6 And (Mid(sNCR, 1, 6) Like "&[#]x03[7-9A-F]") Then
      IsGreekChar = 1
   Else
      IsGreekChar = 0
   End If
End Function

Function TransGreek(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 &H0391
      TransGreek = "A"
    Case &H0392
      TransGreek = "V"
    Case &H0393
      TransGreek = "G"
    Case &H0394
      TransGreek = "D"
    Case &H0395
      TransGreek = "E"
    Case &H0396
      TransGreek = "Z"
    Case &H0397
      TransGreek = "E" & Chr(229)  'E-macron
    Case &H0398
      TransGreek = "Th"
    Case &H0399
      TransGreek = "I"
    Case &H039A
      TransGreek = "K"
    Case &H039B
      TransGreek = "L"
    Case &H039C
      TransGreek = "M"
    Case &H039D
      TransGreek = "N"
    Case &H039E
      TransGreek = "X"
    Case &H039F
      TransGreek = "O"
    Case &H03A0
      TransGreek = "P"
    Case &H03A1
      TransGreek = "R"
    Case &H03A3
      TransGreek = "S"
    Case &H03A4
      TransGreek = "T"
    Case &H03A5
      TransGreek = "Y"
    Case &H03A6
      TransGreek = "Ph"
    Case &H03A7
      TransGreek = "Ch"
    Case &H03A8
      TransGreek = "Ps"
    Case &H03A9
      TransGreek = "O" & Chr(229)  'O-macron

    Case &H03B1
      TransGreek = "a"
    Case &H03B2
      TransGreek = "v"
    Case &H03B3
      TransGreek = "g"
    Case &H03B4
      TransGreek = "d"
    Case &H03B5
      TransGreek = "e"
    Case &H03B6
      TransGreek = "z"
    Case &H03B7
      TransGreek = "e" & Chr(229)  'e-macron
    Case &H03B8
      TransGreek = "th"
    Case &H03B9
      TransGreek = "i"
    Case &H03BA
      TransGreek = "k"
    Case &H03BB
      TransGreek = "l"
    Case &H03BC
      TransGreek = "m"
    Case &H03BD
      TransGreek = "n"
    Case &H03BE
      TransGreek = "x"
    Case &H03BF
      TransGreek = "o"
    Case &H03C0
      TransGreek = "p"
    Case &H03C1
      TransGreek = "r"
    Case &H03C2
      TransGreek = "s"
    Case &H03C3
      TransGreek = "s"
    Case &H03C4
      TransGreek = "t"
    Case &H03C5
      TransGreek = "y"
    Case &H03C6
      TransGreek = "ph"
    Case &H03C7
      TransGreek = "ch"
    Case &H03C8
      TransGreek = "ps"
    Case &H03C9
      TransGreek = "o" & Chr(229)  'o-macron
      'End If

    Case &H0300, &H0301, &H0308, &H0313, &H0345, &H0342
       TransGreek = ""
    Case &H00AB, &H00BB, &H201C, &H201D
       TransGreek = Chr(34)
    Case &H0387
       TransGreek = ";"
    Case &H037E
       TransGreek = "?"

    Case Else
      TransGreek = Chr(252)
  End Select
End Function

'################################################################################

Function TransGreekAlphaNumbers (nStart As Integer, nEnd As Integer, nNumberSign As Long) As String
   Dim sChar As String
   Dim sHex As String
   Dim nHex As Integer
   Dim TempVar As Integer
   Dim sNextHex As String
   Dim nNextHex As Long
   Dim k

   If nNumberSign <> &H0374 and nNumberSign <> &H0375 Then
     TransGreekAlphaNumbers = ""
     Exit Function
   End If

   k = nStart
   TempVar = 0

   If nNumberSign = &H0375 Then  'starts with thousands, (ten thousands and hundred thousands were done various ways, and are difficult to handle)

     sChar = arrChars(k)
     k = k + 1      
     sHex = Mid(sChar, 4, Len(sChar) - 2)
     nHex = Val("&H" & sHex)

     'Do While InStr(sWord, "|") = 1
     '   place = InStr(sWord, "|")
     '   place2 = InStr(place + 1, sWord, "|")
     '   NumUCode = Mid(sWord, place + 1, place2 - place - 1)
     '   sWord = Mid(sWord, place2 + 1)
     '   If TempVar > 1000 Then
     '     sWord = "|" & NumUCode & "|" & sWord
     '     Exit Do
     '   End If
     Select Case nHex
       Case &H03B1
         TempVar = TempVar + 1000
       Case &H03B2
         TempVar = TempVar + 2000
       Case &H03B3
         TempVar = TempVar + 3000
       Case &H03B4
         TempVar = TempVar + 4000
       Case &H03B5
         TempVar = TempVar + 5000
       Case &H03C2
         TempVar = TempVar + 6000
       Case &H03B6
         TempVar = TempVar + 7000
       Case &H03B7
         TempVar = TempVar + 8000
       Case &H03B8
         TempVar = TempVar + 9000
       Case &H03B9
       '  TempVar = TempVar + 10000
       Case &H03BA
       '  TempVar = TempVar + 20000
       Case &H03BB
       '  TempVar = TempVar + 30000
       Case &H03BC
       '  TempVar = TempVar + 40000
       Case &H03BD
       '  TempVar = TempVar + 50000
       Case &H03BE
       '  TempVar = TempVar + 60000
       Case &H03BF
       '  TempVar = TempVar + 70000
       Case &H03C0
       '  TempVar = TempVar + 80000
       Case &H03DF
       '  TempVar = TempVar + 90000
       Case &H03C1
       '  TempVar = TempVar + 100000
       Case &H03C3
       '  TempVar = TempVar + 200000
       Case &H03C4
       '  TempVar = TempVar + 300000
       Case &H03C5
       '  TempVar = TempVar + 400000
       Case &H03C6
       '  TempVar = TempVar + 500000
       Case &H03C7
       '  TempVar = TempVar + 600000
       Case &H03C8
       '  TempVar = TempVar + 700000
       Case &H03C9
       '  TempVar = TempVar + 800000
       Case &H03E1
       '  TempVar = TempVar + 900000
       End Select
     'Loop
   End If

   Do Until k > nEnd
     sChar = arrChars(k)
     k = k + 1
     sHex = Mid(sChar, 4, Len(sChar) - 2)
     nHex = Val("&H" & sHex)
     Select Case nHex
       Case &H03B1
         TempVar = TempVar + 1
       Case &H03B2
         TempVar = TempVar + 2
       Case &H03B3
         TempVar = TempVar + 3
       Case &H03B4
         TempVar = TempVar + 4
       Case &H03B5
         TempVar = TempVar + 5
       Case &H03C2
         TempVar = TempVar + 6
       Case &H03B6
         TempVar = TempVar + 7
       Case &H03B7
         TempVar = TempVar + 8
       Case &H03B8
         TempVar = TempVar + 9
       Case &H03B9
         TempVar = TempVar + 10
       Case &H03BA
         TempVar = TempVar + 20
       Case &H03BB
         TempVar = TempVar + 30
       Case &H03BC
         TempVar = TempVar + 40
       Case &H03BD
         TempVar = TempVar + 50
       Case &H03BE
         TempVar = TempVar + 60
       Case &H03BF
         TempVar = TempVar + 70
       Case &H03C0
         TempVar = TempVar + 80
       Case &H03DF, &H03D9
         TempVar = TempVar + 90
       Case &H03C1
         TempVar = TempVar + 100
       Case &H03C3
         TempVar = TempVar + 200
       Case &H03C4
         TempVar = TempVar + 300
       Case &H03C5
         TempVar = TempVar + 400
       Case &H03C6
         TempVar = TempVar + 500
       Case &H03C7
         TempVar = TempVar + 600
       Case &H03C8
         TempVar = TempVar + 700
       Case &H03C9
         TempVar = TempVar + 800
       Case &H03E1
         TempVar = TempVar + 900
       End Select
   Loop
   TransGreekAlphaNumbers = CStr(TempVar)
End Function