[VBA] [Excel] Convert text to morse code. Support English and Thai only.

MorseCodeVBA.bas

Private Declare PtrSafe Function Beep Lib "kernel32" (ByVal soundFrequency As Long, ByVal soundDuration As Long) As Long
  Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For both 32 and 64 Bit Systems

Private Function IsInArray(stringToBeFound As String, arr As Variant) As Long
  Dim i As Long
  ' default return value if value not found in array
  IsInArray = -1

  For i = LBound(arr) To UBound(arr)
    If StrComp(stringToBeFound, arr(i), vbBinaryCompare) = 0 Then
      IsInArray = i
      Exit For
    End If
  Next i
End Function

Function MorseCode(InputText As String, Optional SoundEnable As Boolean = False)
'Convert Text to Morsecode
'MorseCode version 1.0 by Pongsathorn Sraouthai
'Support for English and Thai only
Dim lngLoop As Long
Dim T1 As Variant
Dim TArr As Variant
Dim RArr As Variant
Dim i, ss, rr, tt, Ut, R1, LangID

R1 = Mid(InputText, 1, 1)
If AscW(R1) > 127 Then LangID = "th" Else LangID = "en"

Select Case LangID
    Case "EN", "en"
        T1 = "A~B~C~D~E~F~G~H~I~J~K~L~M~N~O~P~Q~R~S~T~U~V~W~X~Y~Z~0~1~2~3~4~5~6~7~8~9~.~,~?~'~!~/~(~)~&~:~;~=~-~_~""~$~@~ "
        TArr = Split(T1, "~")
        RArr = Array("8729 8208", "8208 8729 8729 8729", "8208 8729 8208 8729", "8208 8729 8729", "8729", "8729 8729 8208 8729", "8208 8208 8729", "8729 8729 8729 8729", "8729 8729", "8729 8208 8208 8208", "8208 8729 8208", "8729 8208 8729 8729", "8208 8208", "8208 8729", "8208 8208 8208", "8729 8208 8208 8729", "8208 8208 8729 8208", "8729 8208 8729", _
                "8729 8729 8729", "8208", "8729 8729 8208", "8729 8729 8729 8208", "8729 8208 8208", "8208 8729 8729 8208", "8208 8729 8208 8208", "8208 8208 8729 8729", "8208 8208 8208 8208 8208", "8729 8208 8208 8208 8208", "8729 8729 8208 8208 8208", "8729 8729 8729 8208 8208", "8729 8729 8729 8729 8208", "8729 8729 8729 8729 8729", "8208 8729 8729 8729 8729", _
                "8208 8208 8729 8729 8729", "8208 8208 8208 8729 8729", "8208 8208 8208 8208 8729", "8729 8208 8729 8208 8729 8208", "8208 8208 8729 8729 8208 8208", "8729 8729 8208 8208 8729 8729", "8729 8208 8208 8208 8208 8729", "8208 8729 8208 8729 8208 8208", "8208 8729 8729 8208 8729", "8208 8729 8208 8208 8729", "8208 8729 8208 8208 8729 8208", _
                "8729 8208 8729 8729 8729", "8208 8208 8208 8729 8729 8729", "8208 8729 8208 8729 8208 8729", "8208 8729 8729 8729 8208", "8208 8729 8729 8729 8729 8208", "8729 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8208 8729", "8729 8729 8729 8208 8729 8729 8208", "8729 8208 8208 8729 8208 8729", "32")
    Case "TH", "th"
        T1 = "ก~ข~ฃ~ค~ฅ~ฆ~ง~จ~ฉ~ช~ซ~ฌ~ญ~ฎ~ฏ~ฐ~ฑ~ฒ~ณ~ด~ต~ถ~ท~ธ~น~บ~ป~ผ~ฝ~พ~ฟ~ภ~ม~ย~ร~ล~ว~ศ~ษ~ส~ห~ฬ~อ~ฮ~ะ~า~ิ~ี~ึ~ื~ุ~ู~เ~แ~โ~ใ~ไ~ั~็~ำ~ฤ~ฦ~่~้~๊~๋~์~ๆ~ฯ~.~,~?~'~!~/~(~)~&~:~;~=~-~_~""~0~1~2~3~4~5~6~7~8~9~๐~๑~๒~๓~๔~๕~๖~๗~๘~๙~ "
        TArr = Split(T1, "~")
        RArr = Array("8208 8208 8729", "8208 8729 8208 8729", "8208 8729 8208 8729", "8208 8729 8208", "8208 8729 8208", "8208 8729 8208", "8208 8729 8208 8208 8729", "8208 8729 8729 8208 8729", "8208 8208 8208 8208", "8208 8729 8729 8208", "8208 8208 8729 8729", "8208 8729 8729 8208", "8729 8208 8208 8208", "8208 8729 8729", "8208", _
                    "8208 8729 8208 8729 8729", "8208 8729 8729 8208 8208", "8208 8729 8729 8208 8208", "8208 8729", "8208 8729 8729", "8208", "8208 8729 8208 8729 8729", "8208 8729 8729 8208 8208", "8208 8729 8729 8208 8208", "8208 8729", "8208 8729 8729 8729", "8729 8208 8208 8729", "8208 8208 8729 8208", "8208 8729 8208 8729 8208", _
                    "8729 8208 8208 8729 8729", "8729 8729 8208 8729", "8729 8208 8208 8729 8729", "8208 8208", "8208 8729 8208 8208", "8729 8208 8729", "8729 8208 8729 8729", "8729 8208 8208", "8729 8729 8729", "8729 8729 8729", "8729 8729 8729", "8729 8729 8729 8729", "8729 8208 8729 8729", "8208 8729 8729 8729 8208", _
                    "8208 8208 8729 8208 8208", "8729 8208 8729 8729 8729 ", "8729 8208", "8729 8729 8208 8729 8729 ", "8729 8729", "8729 8729 8208 8208 8729", "8729 8729 8208 8208", "8729 8729 8208 8729 8208", "8208 8208 8208 8729", "8729", "8729 8208 8729 8208", "8208 8208 8208", "8729 8208 8729 8729 8208", "8729 8208 8729 8729 8208", _
                    "8729 8208 8208 8729 8208", "8208 8208 8208 8729 8729", "8729 8729 8729 8208 8729 ", "8729 8208 8729 8208 8208", "8729 8208 8729 8208 8208", "8729 8729 8208", "8729 8729 8729 8208", "8208 8208 8729 8729 8729", "8729 8208 8729 8208 8729 ", "8208 8208 8729 8729 8208", "8208 8729 8208 8208 8208", "8208 8208 8729 8208 8729", _
                    "8729 8208 8729 8208 8729 8208", "8208 8208 8729 8729 8208 8208", "8729 8729 8208 8208 8729 8729", "8729 8208 8208 8208 8208 8729", "8208 8729 8208 8729 8208 8208", "8208 8729 8729 8208 8729", "8208 8729 8208 8208 8729", "8208 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8729", "8208 8208 8208 8729 8729 8729", _
                    "8208 8729 8208 8729 8208 8729", "8208 8729 8729 8729 8208", "8208 8729 8729 8729 8729 8208", "8729 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8208 8729", "8208 8208 8208 8208 8208", "8729 8208 8208 8208 8208", "8729 8729 8208 8208 8208", "8729 8729 8729 8208 8208", "8729 8729 8729 8729 8208", "8729 8729 8729 8729 8729", _
                    "8208 8729 8729 8729 8729", "8208 8208 8729 8729 8729", "8208 8208 8208 8729 8729", "8208 8208 8208 8208 8729", "8208 8208 8208 8208 8208", "8729 8208 8208 8208 8208", "8729 8729 8208 8208 8208", "8729 8729 8729 8208 8208", "8729 8729 8729 8729 8208", "8729 8729 8729 8729 8729", "8208 8729 8729 8729 8729", _
                    "8208 8208 8729 8729 8729", "8208 8208 8208 8729 8729", "8208 8208 8208 8208 8729", "32")
    Case Else
        MorseCode = "#N/A"
End Select
        
MorseCode = ""
Ut = UCase(InputText)
For i = 1 To Len(Ut)
    tt = Mid(Ut, i, 1)
    rr = IsInArray(CStr(tt), TArr)
    ss = Replace(tt, TArr(rr), U2W(RArr(rr)))
    MorseCode = MorseCode & ss & "  "
Next i

If Right(MorseCode, 2) = "  " Then MorseCode = Mid(MorseCode, 1, Len(MorseCode) - 2)

If SoundEnable Then
'Generate Sound
    For lngLoop = 1 To Len(MorseCode)
        Select Case Mid(MorseCode, lngLoop, 1)
            Case ChrW(8729):
                Beep 1000, 100
            Case ChrW(8208):
                Beep 1000, 300
            Case " "
                Sleep (500)
        End Select
    Next lngLoop
End If

End Function

Function MorseDec(MorseText As String, Optional MorseLang As String = "en", Optional SoundEnable As Boolean = False) As String
'Morse Decode
'Version 1.0 by Pongsathon Sraouthai
'for decode morse code
'Support language (MorseLang): English (INTL)(EN) and Thai (TH)
'Support Sound (SoundEnable): True = Enable Sound, False = No Sound (Default)

Dim lngLoop As Long
Dim T1 As Variant, TArr As Variant
Dim RArr As Variant, R1 As Variant, R2 As Variant
Dim i, j, k, rr, ss, rss, rrs, cs, co

'Decode to normal text
Select Case MorseLang
    Case "EN", "en"
        RArr = Array("8729 8208", "8208 8729 8729 8729", "8208 8729 8208 8729", "8208 8729 8729", "8729", "8729 8729 8208 8729", "8208 8208 8729", "8729 8729 8729 8729", "8729 8729", "8729 8208 8208 8208", "8208 8729 8208", "8729 8208 8729 8729", "8208 8208", "8208 8729", "8208 8208 8208", "8729 8208 8208 8729", "8208 8208 8729 8208", "8729 8208 8729", _
                "8729 8729 8729", "8208", "8729 8729 8208", "8729 8729 8729 8208", "8729 8208 8208", "8208 8729 8729 8208", "8208 8729 8208 8208", "8208 8208 8729 8729", "8208 8208 8208 8208 8208", "8729 8208 8208 8208 8208", "8729 8729 8208 8208 8208", "8729 8729 8729 8208 8208", "8729 8729 8729 8729 8208", "8729 8729 8729 8729 8729", "8208 8729 8729 8729 8729", _
                "8208 8208 8729 8729 8729", "8208 8208 8208 8729 8729", "8208 8208 8208 8208 8729", "8729 8208 8729 8208 8729 8208", "8208 8208 8729 8729 8208 8208", "8729 8729 8208 8208 8729 8729", "8729 8208 8208 8208 8208 8729", "8208 8729 8208 8729 8208 8208", "8208 8729 8729 8208 8729", "8208 8729 8208 8208 8729", "8208 8729 8208 8208 8729 8208", _
                "8729 8208 8729 8729 8729", "8208 8208 8208 8729 8729 8729", "8208 8729 8208 8729 8208 8729", "8208 8729 8729 8729 8208", "8208 8729 8729 8729 8729 8208", "8729 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8208 8729", "8729 8729 8729 8208 8729 8729 8208", "8729 8208 8208 8729 8208 8729", "32 32 32")
        TArr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ".", ",", "?", "'", "!", "/", "(", ")", "&", ":", ";", "=", "-", "_", """", "$", "@", " ")
    Case "TH", "th"
        T1 = "ก~ข~ฃ~ค~ฅ~ฆ~ง~จ~ฉ~ช~ซ~ฌ~ญ~ฎ~ฏ~ฐ~ฑ~ฒ~ณ~ด~ต~ถ~ท~ธ~น~บ~ป~ผ~ฝ~พ~ฟ~ภ~ม~ย~ร~ล~ว~ศ~ษ~ส~ห~ฬ~อ~ฮ~ะ~า~ิ~ี~ึ~ื~ุ~ู~เ~แ~โ~ใ~ไ~ั~็~ำ~ฤ~ฦ~่~้~๊~๋~์~ๆ~ฯ~.~,~?~'~!~/~(~)~&~:~;~=~-~_~""~ "
        TArr = Split(T1, "~")
        RArr = Array("8208 8208 8729", "8208 8729 8208 8729", "8208 8729 8208 8729", "8208 8729 8208", "8208 8729 8208", "8208 8729 8208", "8208 8729 8208 8208 8729", "8208 8729 8729 8208 8729", "8208 8208 8208 8208", "8208 8729 8729 8208", "8208 8208 8729 8729", "8208 8729 8729 8208", "8729 8208 8208 8208", "8208 8729 8729", "8208", _
                    "8208 8729 8208 8729 8729", "8208 8729 8729 8208 8208", "8208 8729 8729 8208 8208", "8208 8729", "8208 8729 8729", "8208", "8208 8729 8208 8729 8729", "8208 8729 8729 8208 8208", "8208 8729 8729 8208 8208", "8208 8729", "8208 8729 8729 8729", "8729 8208 8208 8729", "8208 8208 8729 8208", "8208 8729 8208 8729 8208", _
                    "8729 8208 8208 8729 8729", "8729 8729 8208 8729", "8729 8208 8208 8729 8729", "8208 8208", "8208 8729 8208 8208", "8729 8208 8729", "8729 8208 8729 8729", "8729 8208 8208", "8729 8729 8729", "8729 8729 8729", "8729 8729 8729", "8729 8729 8729 8729", "8729 8208 8729 8729", "8208 8729 8729 8729 8208", _
                    "8208 8208 8729 8208 8208", "8729 8208 8729 8729 8729 ", "8729 8208", "8729 8729 8208 8729 8729 ", "8729 8729", "8729 8729 8208 8208 8729", "8729 8729 8208 8208", "8729 8729 8208 8729 8208", "8208 8208 8208 8729", "8729", "8729 8208 8729 8208", "8208 8208 8208", "8729 8208 8729 8729 8208", "8729 8208 8729 8729 8208", _
                    "8729 8208 8208 8729 8208", "8208 8208 8208 8729 8729", "8729 8729 8729 8208 8729 ", "8729 8208 8729 8208 8208", "8729 8208 8729 8208 8208", "8729 8729 8208", "8729 8729 8729 8208", "8208 8208 8729 8729 8729", "8729 8208 8729 8208 8729 ", "8208 8208 8729 8729 8208", "8208 8729 8208 8208 8208", "8208 8208 8729 8208 8729", _
                    "8729 8208 8729 8208 8729 8208", "8208 8208 8729 8729 8208 8208", "8729 8729 8208 8208 8729 8729", "8729 8208 8208 8208 8208 8729", "8208 8729 8208 8729 8208 8208", "8208 8729 8729 8208 8729", "8208 8729 8208 8208 8729", "8208 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8729", "8208 8208 8208 8729 8729 8729", _
                    "8208 8729 8208 8729 8208 8729", "8208 8729 8729 8729 8208", "8208 8729 8729 8729 8729 8208", "8729 8729 8208 8208 8729 8208", "8729 8208 8729 8729 8208 8729", "32")
    Case Else
End Select

If InStr(1, MorseText, "     ") > 0 Then 'กรณีมีหลายคำ
    rss = ""
    If Right(MorseText, 2) = "  " Then MorseText = Mid(MorseText, 1, Len(MorseText) - 2)
    R1 = Split(MorseText, "     ")
    For j = LBound(R1) To UBound(R1)
        If InStr(1, R1(j), "  ") = 0 Then 'กรณีมีตัวเดียว
            R2 = R1(j)
            cs = Mid(W2U(CStr(R2)), 1, Len(W2U(CStr(R2))) - 1)
            rr = IsInArray(CStr(cs), RArr)
            ss = Replace(R2, U2W(cs), TArr(rr))
            rrs = ss
        Else 'กรณีมีหลายตัว
            R2 = Split(R1(j), "  ")
            For k = LBound(R2) To UBound(R2)
                cs = Mid(W2U(CStr(R2(k))), 1, Len(W2U(CStr(R2(k)))) - 1)
                rr = IsInArray(CStr(cs), RArr)
                ss = Replace(R2(k), U2W(cs), TArr(rr))
                rrs = rrs & ss
            Next k
        End If
        rss = rss & rrs & " "
        rrs = ""
    Next j
Else 'กรณีมีคำเดียว ...  --  ...
    rss = ""
    If InStr(1, MorseText, "  ") = 0 Then 'กรณีมีอักษรตัวเดียว
        cs = Left(W2U(MorseText), Len(W2U(MorseText)) - 1)
        rr = IsInArray(CStr(cs), RArr)
        ss = Replace(MorseText, U2W(cs), TArr(rr))
        rss = ss
    Else
        R1 = Split(MorseText, "  ")
        For i = LBound(R1) To UBound(R1)
            cs = Mid(W2U(CStr(R1(i))), 1, Len(W2U(CStr(R1(i)))) - 1)
            rr = IsInArray(CStr(cs), RArr)
            ss = Replace(R1(i), U2W(cs), TArr(rr))
            rss = rss & ss
        Next i
    End If
End If

If SoundEnable Then
'Generate Sound
For lngLoop = 1 To Len(MorseText)
    Select Case Mid(MorseText, lngLoop, 1)
        Case ChrW(8729):
            Beep 1000, 100
        Case ChrW(8208):
            Beep 1000, 300
        Case " "
            Sleep (500)
    End Select
Next lngLoop

End If

MorseDec = rss

End Function

Function W2U(iText As String)
'Convert Word to unicode number of character [017]
Dim N, AllChar
For N = Len(iText) To 1 Step -1
    AllChar = AscW(Mid(iText, N, 1)) & " " & AllChar
Next
W2U = AllChar
End Function

Function U2W(iCode, Optional AddSpace As Boolean = False) As String
'Convert Unicode number to text [018]
Dim N, AllChar, str, ns()
str = Split(iCode, " ")
ReDim ns(UBound(str))
For N = UBound(str) To 0 Step -1
    If IsNumeric(str(N)) Then
        ns(N) = CLng(str(N))
        Select Case AddSpace
            Case True
                AllChar = ChrW(ns(N)) & " " & AllChar
            Case False
                AllChar = ChrW(ns(N)) & AllChar
        End Select
    End If
Next
U2W = AllChar
End Function