Displaying Cyrillic in Unicode components

I was unable to use Cyrillic in the new Unicode components. I was offered to load text lines from a file, but this is inconvenient. Therefore, I wrote a small class that allows you to use Cyrillic directly from the code.

Code:

Private Cyrillic As Collection



Private Sub Class_Initialize()



  Const LETTER_E_CAPITAL_UNICODE  As Long = 1025

  Const LETTER_E_SMALL_UNICODE As Long = 1105

  Const LETTER_E_CAPITAL_ANSI As Long = 168

  Const LETTER_E_SMALL_ANSI As Long = 184

  Const RUSSIAN_FIRST_LETTER_UNICODE As Long = 1040

  Const RUSSIAN_LAST_LETTER_UNICODE As Long = 1102

  Const RUSSIAN_FIRST_LETTER_ANSI As Long = 191

  

  Dim i As Long

  Dim rCount As Long

    

  Set Cyrillic = New Collection

  rCount = RUSSIAN_FIRST_LETTER_ANSI

  

  For i = RUSSIAN_FIRST_LETTER_UNICODE To RUSSIAN_LAST_LETTER_UNICODE

  

   rCount = rCount + 1

   Cyrillic.Add i, TrimAndStr(rCount)

   

  Next

   

  'Letter processing "Ё"

  

   Cyrillic.Add LETTER_E_CAPITAL_UNICODE, TrimAndStr(LETTER_E_CAPITAL_ANSI)

   Cyrillic.Add LETTER_E_SMALL_UNICODE, TrimAndStr(LETTER_E_SMALL_ANSI)



End Sub



Private Sub Class_Terminate()

 Set Cyrillic = Nothing

End Sub



Private Function TrimAndStr(value As Long) As String

 TrimAndStr = Trim$(Str$(value))

End Function



Public Function CyrToUnicode(strCyr As String) As String



    Dim Arr() As String

    Dim letter As Variant

 

    If LenB(Trim$(strCyr)) = vbEmpty Then Exit Function



    ReDim Arr(Len(strCyr) - 1)



    For i = 0 To UBound(Arr)

        Arr(i) = Mid$(strCyr, i + 1, 1)

    Next



   On Error Resume Next



        For Each letter In Arr

          

           CyrToUnicode = CyrToUnicode & ChrW$(Cyrillic(TrimAndStr(Asc(letter))))

         

               If Err Then

                   CyrToUnicode = CyrToUnicode & letter

                   Err.Clear

               End If

            

        Next



    On Error GoTo 0



End Function