[VBA][Excel] EnglishTime Spelling time to English

EngTime.bas

Function EnglishTime(InTime, Optional Formal As Integer = 1)
'Convert Time to English Text
'Formal
'1 = Formal
'2 = Informal
'3 = Military

Dim tInput, ThH, ThM, ThS
Select Case VarType(InTime)
    Case vbDate
        'format as time
        tInput = TimeValue(InTime)
        ThH = hour(tInput)
        ThM = Minute(tInput)
        ThS = Second(tInput)
    Case vbDecimal
        'format as decimal
        tInput = Int(InTime)
        ThH = tInput
        ThM = (InTime - tInput) * 100
        ThS = 0
    Case vbString
        'format as text
        If InStr(1, InTime, ":", vbTextCompare) >= 1 Then
            tInput = TimeValue(InTime)
            ThH = hour(tInput)
            ThM = Minute(tInput)
            ThS = Second(tInput)
        ElseIf InStr(1, InTime, ".", vbTextCompare) >= 1 Then
            tInput = TimeValue(Replace(InTime, ".", ":"))
            ThH = hour(tInput)
            ThM = Minute(tInput)
            ThS = Second(tInput)
        End If
    Case vbDouble
        'format as decimal
        tInput = InTime
        ThH = hour(tInput)
        ThM = Minute(tInput)
        ThS = Second(tInput)
    Case Else
        EnglishTime = "!!!"
End Select
Select Case Formal
    Case 1 'Formal
        If ThH > 12 Then ThH = ThH - 12
        Select Case ThH
            Case Is = 0
                If ThM = 0 Then
                    EnglishTime = "mid night"
                ElseIf ThM > 0 And ThM < 10 Then
                    EnglishTime = EngNSound(12) & " oh " & EngNSound(ThM)
                Else
                    EnglishTime = EngNSound(12) & "-" & EngNSound(ThM)
                End If
            Case Is < 12
                If ThM = 0 Then
                    EnglishTime = EngNSound(ThH) & " o'clock"
                ElseIf ThM > 0 And ThM < 10 Then
                    EnglishTime = EngNSound(ThH) & " oh " & EngNSound(ThM)
                Else
                    EnglishTime = EngNSound(ThH) & "-" & EngNSound(ThM)
                End If
            Case Is = 12
                If ThM = 0 Then
                    EnglishTime = "noon"
                ElseIf ThM > 0 And ThM < 10 Then
                    EnglishTime = EngNSound(ThH) & " oh " & EngNSound(ThM)
                Else
                    EnglishTime = EngNSound(ThH) & "-" & EngNSound(ThM)
                End If
        End Select
    Case 2 'Informal
        If ThH > 12 Then ThH = ThH - 12
        Select Case ThM
            Case Is = 0
                Select Case ThH
                    Case Is = 0
                        EnglishTime = "mid night"
                    Case Is > 0, Is < 12
                        EnglishTime = EngNSound(ThH) & " o'clock"
                    Case Is = 12
                        EnglishTime = "noon"
                End Select
            Case Is < 15
                EnglishTime = EngNSound(ThM) & " pass " & EngNSound(ThH)
            Case Is = 15
                EnglishTime = "a quarter pass " & EngNSound(ThH)
            Case Is < 30
                EnglishTime = EngNSound(ThM) & " pass " & EngNSound(ThH)
            Case Is = 30
                EnglishTime = "half pass " & EngNSound(ThH)
            Case Is < 45
                ThH = ThH + 1
                If ThH > 12 Then ThH = ThH - 12
                ThM = 60 - ThM
                EnglishTime = EngNSound(ThM) & " to " & EngNSound(ThH)
            Case Is = 45
                ThH = ThH + 1
                If ThH > 12 Then ThH = ThH - 12
                EnglishTime = "a quarter to " & EngNSound(ThH)
            Case Is <= 59
                ThH = ThH + 1
                If ThH > 12 Then ThH = ThH - 12
                ThM = 60 - ThM
                EnglishTime = EngNSound(ThM) & " to " & EngNSound(ThH)
        End Select
    Case 3 'Military
        Select Case ThH
            Case Is = 0
                Select Case ThM
                    Case Is = 0
                        EnglishTime = "Zero hundred hours"
                    Case Is < 10
                        EnglishTime = "Zero hundred Zero " & EngNSound(ThM) & " hours"
                    Case Else
                        EnglishTime = "Zero Zero " & EngNSound(ThM) & " hours"
                End Select
            Case Is < 10
                Select Case ThM
                    Case Is = 0
                        EnglishTime = "Zero " & EngNSound(ThH) & " hundred hours"
                    Case Is < 10
                        EnglishTime = "Zero " & EngNSound(ThH) & " Zero " & EngNSound(ThM) & " hours"
                    Case Else
                        EnglishTime = "Zero " & EngNSound(ThH) & " " & EngNSound(ThM) & " hours"
                End Select
            Case Else
                Select Case ThM
                    Case Is = 0
                        EnglishTime = EngNSound(ThH) & " hundred hours"
                    Case Is < 10
                        EnglishTime = EngNSound(ThH) & " Zero " & EngNSound(ThM) & " hours"
                    Case Else
                        EnglishTime = EngNSound(ThH) & " " & EngNSound(ThM) & " hours"
                End Select
        End Select
    Case Else
        EnglishTime = "!!!"
End Select

EnglishTime = LCase(EnglishTime)

End Function

Function EngDSound(ByVal NumIn, Optional EngType As String = "US") As String
'Version 2.5
'Convert decimal number to sound text.
    Dim LSide, RSide, Temp, DecPlace, count, oNum, dNum, rNum, rpNum
    'cNum = CLng(NumIn)
    oNum = NumIn
    ReDim place(9) As String
    Select Case EngType '2.51
        Case "US", "AU"
            place(2) = " Thousand "
            place(3) = " Million "
            place(4) = " Billion "
            place(5) = " Trillion "
        Case "UK", "EU" '2.51
            If val(Right(CStr(NumIn), 3)) = 0 Then
                place(2) = " Grand "
            ElseIf val(Right(CStr(NumIn), 3)) >= 1 And val(Right(CStr(NumIn), 3)) <= 99 Then
                place(2) = " Thousand and "
            Else
                place(2) = " Thousand, "
            End If
            If val(Right(CStr(NumIn), 6)) = 0 Then
                place(3) = " Million "
            ElseIf val(Right(CStr(NumIn), 3)) >= 1 And val(Right(CStr(NumIn), 6)) <= 99 Then
                place(3) = " Million and "
            Else
                place(3) = " Million, "
            End If
            If val(Right(CStr(NumIn), 9)) = 0 Then
                place(4) = " Billion "
            ElseIf val(Right(CStr(NumIn), 3)) >= 1 And val(Right(CStr(NumIn), 9)) <= 99 Then
                place(4) = " Billion and "
            Else
                place(4) = " Billion, "
            End If
            If val(Right(CStr(NumIn), 12)) = 0 Then
                place(5) = " Trillion "
            ElseIf val(Right(CStr(NumIn), 3)) >= 1 And val(Right(CStr(NumIn), 12)) <= 99 Then
                place(5) = " Trillion and "
            Else
                place(5) = " Trillion, "
            End If
    End Select
    NumIn = Trim(CStr(NumIn)) 'String representation of amount
    DecPlace = InStr(NumIn, ".") 'Pos of dec place 0 if none
    If DecPlace > 0 Then 'Convert Right & set numIn
        RSide = GetTens(Left(Mid(NumIn, DecPlace + 1) & "00", 2))
        NumIn = Trim(Left(NumIn, DecPlace - 1))
    End If
    RSide = NumIn
    count = 1
    Do While NumIn <> ""
        Temp = GetHundreds(Right(NumIn, 3), EngType)
        If Temp <> "" Then LSide = Temp & place(count) & LSide
        If Len(NumIn) > 3 Then
            NumIn = Left(NumIn, Len(NumIn) - 3)
        Else
            NumIn = ""
        End If
        count = count + 1
    Loop
    EngDSound = LSide
    If oNum = 0 Then EngDSound = "Zero"
    If InStr(oNum, Application.DecimalSeparator) > 0 Then
        dNum = InStr(oNum, Application.DecimalSeparator)
        If Len(oNum) >= 3 And CStr(oNum) = "0.0" Then
            EngDSound = "Zero Point Zero"
        Else
            If Mid(oNum, 1, 1) = "0" Then EngDSound = "Zero"
            rNum = Right(CStr(oNum), Len(CStr(oNum)) - dNum)
            EngDSound = EngDSound & " Point " & EngNString(CStr(rNum))
        End If
    End If
    If EngType = "UK" And InStr(1, EngDSound, "One") = 1 Then '2.51
        EngDSound = Replace(Trim(EngDSound), "One", "A", 1, 1)
    End If
    
    EngDSound = Trim(EngDSound)
End Function
                
Function EngDString(ByVal sNum) As String
'Version 1.0
'Convert number to english text digit by word
Dim rn, dp

EngDString = EngNString(CStr(sNum))
If InStr(sNum, Application.DecimalSeparator) > 0 Then
    dp = InStr(sNum, Application.DecimalSeparator)
    If Len(sNum) = 3 And Mid(sNum, 1, 3) = "0.0" Then
        EngDString = "Zero point Zero"
    ElseIf Len(sNum) >= 3 Then
        rn = Right(sNum, Len(sNum) - dp)
        EngDString = EngDString & " Point " & EngNString(rn)
    End If
End If
End Function
                
Function EngNSound(ByVal sNum, Optional EngType As String = "US") As String
'Version 1.0
'Convert integer number to text

Dim dpos
If InStr(1, sNum, ".") >= 1 Then
    dpos = InStr(1, sNum, ".", vbTextCompare)
    sNum = val(Left(sNum, dpos - 1))
End If
If sNum = 0 Then
    EngNSound = "Zero"
Else
    EngNSound = EngDSound(sNum, EngType)
End If
EngNSound = Trim(EngNSound)
End Function