ต้องการเขียน Code ตัวเลขจำนวนเงิน ให้เป็นตัวหนังสือ
กระทู้เก่าบอร์ด อ.สุภาพ ไชยา

 371   3
URL.หัวข้อ / URL
ต้องการเขียน Code ตัวเลขจำนวนเงิน ให้เป็นตัวหนังสือ


3 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R05088

Function Baht_Text(ByVal sNum As String, Optional BahtStr As String = "บาท", Optional StangStr = "สตางค์", Optional DecStyle As Integer = 1) As String
Dim sNumber As Variant, sDigit As Variant, sDigit10 As Variant
Dim nLen As Integer, sWord As String, sWord2 As String, Part2 As String
Dim sByte As String, I As Integer, J As Integer

sNumber = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
sDigit = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
sDigit10 = Array("", "สิบ", "ยี่สิบ", "สามสิบ", "สี่สิบ", "ห้าสิบ", "หกสิบ", "เจ็ดสิบ", "แปดสิบ", "เก้าสิบ")
sNum = Format(sNum, "#.000000")
If Left(Right(sNum, 4), 1) >= "5" Then sNum = (Int(sNum * 100) + 1) / 100
sNum = Format(sNum, "#.00")
nLen = Len(sNum)
If sNum = ".00" Then Baht_Text = "ศูนย์"
For I = 1 To nLen - 3
J = (15 + nLen - I) Mod 6
sByte = Mid(sNum, I, 1)
If sByte <> "0" Then
If J = 1 Then sWord = sDigit10(sByte) Else sWord = sNumber(sByte) & sDigit(J)
Baht_Text = Baht_Text & sWord
End If
If J = 0 And I <> nLen - 3 Then Baht_Text = Baht_Text & "ล้าน": Baht_Text = Application.Substitute(Baht_Text, "หนึ่งล้าน", "เอ็ดล้าน")
Next
If Left(Baht_Text, 8) = "เอ็ดล้าน" Then Baht_Text = "หนึ่ง" & Mid(Baht_Text, 5)
If Len(Baht_Text) > 0 Then Baht_Text = Baht_Text & BahtStr
If nLen > 4 Then Baht_Text = Application.Substitute(Baht_Text, "หนึ่ง" & BahtStr, "เอ็ด" & BahtStr)
sNum = Right(sNum, 2)
If sNum = "00" Then
Baht_Text = Baht_Text & "ถ้วน"
Else
If DecStyle = 1 Then
Part2 = sDigit10(Left(sNum, 1)) & sNumber(Right(sNum, 1)) & StangStr
If Left(sNum, 1) <> "0" Then Part2 = Application.Substitute(Part2, "หนึ่ง", "เอ็ด")
Baht_Text = Baht_Text & Part2
Else
sNumber(0) = "ศูนย์"
Baht_Text = Baht_Text & sNumber(Left(sNum, 1)) & sNumber(Right(sNum, 1)) & StangStr
End If
End If

End Function

ลองใช้ดู
2 @R05097
text2.value=WorksheetFunction.BahtText(text1.value)


แต่ต้อง Add ref. ตัว Microsoft excel 10.0 หรือ 8.0 Object Library
ด้วย
3 @R05110
ขอบคุณ คุณ Ken มากครับ
วิธีที่สอง Add ยังไงครับ
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.1336s