Private Sub Command1_Click()
MsgBox BahtText(12021.75)
End Sub
Private Function BahtText(ByVal dNumber As Currency) As String
Dim xSatang As String
Dim xBaht As String
Dim ret As String, xNum As String
Dim n1() As String
ret = ""
xNum = Format(dNumber, "0.00")
n1 = Split(xNum, ".")
xBaht = Trim(n1(0))
xSatang = Trim(n1(1))
If Val(xBaht) > 0 Then
ret = NumberToThaiText(xBaht) + "บาท"
End If
If Val(xSatang) > 0 Then
ret = ret & NumberToThaiText(xSatang) + "สตางค์"
Else
ret = ret + "ถ้วน"
End If
BahtText = ret
End Function
Private Function NumberToThaiText(ByVal pNum As String)
Dim arrayUnit() As String, arrayNum() As String
Dim xNumLen As Integer
Dim ch As String, ch_old As String, xNum As String, xUnit As String
Dim ret As String
Dim i As Integer
ret = ""
arrayUnit = Split("แสน,,สิบ,ร้อย,พัน,หมื่น", ",")
arrayNum = Split("ศูนย์,หนึ่ง,สอง,สาม,สี่,ห้า,หก,เจ็ด,แปด,เก้า", ",")
xNumLen = Len(pNum)
For i = xNumLen To 1 Step -1
ch_old = ch
ch = Mid(pNum, xNumLen - i + 1, 1)
xNum = Trim(arrayNum(Val(ch)))
xUnit = Trim(arrayUnit(i Mod 6))
xUnit = IIf(xUnit = "" And i > 6, "ล้าน", xUnit)
If xUnit = "สิบ" And ch = "1" Then
xNum = ""
ElseIf xUnit = "สิบ" And ch = "2" Then
xNum = "ยี่"
ElseIf xUnit = "" And ch = "1" And xNumLen > i And ch_old > "0" Then
xNum = "เอ็ด"
End If
If xNum <> "ศูนย์" Or xUnit = "ล้าน" Then
ret = ret & IIf(ch = "0", "", xNum) & xUnit
End If
Next i
NumberToThaiText = ret
End Function
ไม่มีความคิดเห็น:
แสดงความคิดเห็น