[VB6/VBA/VB.Net] การแปลงจำนวนเงินเป็นข้อความภาษาไทย
http://www.g2gnet.com/webboard/images/vb6/convertnum2thai.pngยกมาทั้งตระกูล Visual Basic กันเลยทีเดียว แต่ทว่าโค้ดที่แอดมินจะแจกนี้ เขียนเป็น ฟังค์ชั่นในการแปลงเอาไว้ให้อยู่ใน VB6 ที่เหลือก็ตัดแปะนำไปใช้งานกันเอาตามสบายครับ ซึ่งสามารถรองรับจำนวนตัวเลขระดับล้านล้านได้ เว่อร์วังอลังการมาก คำอธิบายจะอยู่ในโค้ด ซึ่งแอดมินพยายามแจกแจงอธิบายรายละเอียดยิบกันเลยทีเดียว ...
มาดูโค้ดกันเถอะ ...
' / --------------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose : Convert numerical to Thai word.
' / Microsoft Visual Basic 6.0 (SP6)
' /
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------------
Option Explicit
' / --------------------------------------------------------------------------------------
Private Sub cmdConvert_Click()
txtThaiWord.Text = "" ' เคลียร์ค่าผลลัพธ์
txtThaiWord.Text = NumberToThaiWord(txtNumber.Text)
End Sub
' / --------------------------------------------------------------------------------------
Private Sub Form_Load()
txtNumber.Text = "9999999999101" '"365001.23"
txtThaiWord.Text = ""
End Sub
' / --------------------------------------------------------------------------------------
' / ฟังค์ชั่นในการแปลงตัวเลขให้เป็นจำนวนภาษาไทย
' / การเรียกใช้งาน :ให้ส่งค่ามาแบบ String
' / NumberToThaiWord("1234.55")
' / NumberToThaiWord(ตัวแปร)
Function NumberToThaiWord(strNumber As String) As String
' / --------------------------------------------------------------------------------------
Dim strThaiBahtAs String
Dim strThaiStang As String
'// คำประจำหลัก
Dim arrUnit(6) As String
arrUnit(0) = ""
arrUnit(1) = "สิบ"
arrUnit(2) = "ร้อย"
arrUnit(3) = "พัน"
arrUnit(4) = "หมื่น"
arrUnit(5) = "แสน"
arrUnit(6) = "ล้าน"
'// แยกเงินบาทกับสตางค์ออกจากกันด้วยเครื่องหมายทศนิยม
Dim strBaht As String, strStang As String
Dim arrNum As Variant
'// เช็คว่ามีจุดทศนิยมด้วยหรือไม่
If InStr(strNumber, ".") <> 0 Then
arrNum = Split(strNumber, ".")
'// บาท
strBaht = CDbl(arrNum(0))
'// สตางค์
strStang = arrNum(1)
Else
strBaht = CDbl(strNumber)
strStang = 0
End If
Dim i As Byte
'// หาหลักล้าน
Dim Million As Byte
If (Len(strBaht) >= 7) Then
Million = Len(strBaht) - 6
'/ หาหลักที่เกินล้าน
For i = 1 To Million
If Mid$(strBaht, i, 1) <> 0 Then strThaiBaht = strThaiBaht + ThaiDigit(Mid$(strBaht, i, 1)) + arrUnit(Million - i)
Next
strThaiBaht = strThaiBaht + "ล้าน"
End If
'// หาเงินส่วนที่ไม่เกินล้าน
'strBaht = Trim(Right(arrNum(0), 6))
strBaht = Trim(Right(strBaht, 6))
'// คิดจำนวนเต็มก่อน
For i = 1 To Len(strBaht)
'// ดักค่าก่อนว่าหลักนั้นๆต้องมีค่าไม่ใช่ 0 เพื่อไม่ให้มีคำประจำหลักติดมา เช่น ...
'// 301 จะต้องข้ามหลักสิบไป
If Mid$(strBaht, i, 1) <> 0 Then
'// วิธีการคิด ...
'// ThaiDigit(Mid$(strBaht, i, 1)) คือ การรับค่าตัวเลขทีละหลักจากซ้ายไปขวา แล้วส่งไปเทียบค่าภาษาไทย
'// เช่น 321
'// รอบที่ 1 เมื่อ i = 1 ก็เลือกเอาเฉพาะหลักซ้ายมือสุด Mid("321", 1, 1) = 1 ตรงกับ "สาม"
'// รอบที่ 2 เมื่อ i = 2 ก็เลือกเอาเฉพาะหลักที่สอง Mid("321", 2, 1) = 2 ตรงกับ "สอง"
'// รอบที่ 3 เมื่อ i = 3 ก็เลือกเอาเฉพาะหลักที่สาม Mid("321", 3, 1) = 1 ตรงกับ "หนึ่ง"
'// arrUnit(Len(strBaht) - i) คือ คำประจำหลัก
'// เช่น 321 มีความยาว หรือ Len(strBaht) = 3
'// รอบที่ 1 เมื่อ i = 1 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 1 ตรงกับ arrUnit(2) = "ร้อย"
'// รอบที่ 2 เมื่อ i = 2 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 2 ตรงกับ arrUnit(1) = "สิบ"
'// รอบที่ 3 เมื่อ i = 3 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 3 ตรงกับ arrUnit(0) = "" (หลักหน่วยปล่อยว่าง)
strThaiBaht = strThaiBaht & ThaiDigit(Mid$(strBaht, i, 1)) & arrUnit(Len(strBaht) - i)
'// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
End If
Next
'// คำสุดท้ายคือคำลงท้ายด้วย "หนึ่ง" สำหรับการอ่านตัวเลขมากกว่า 2 หลักขึ้นไป
'// เช่น 1001, 5001, 65001
If Len(strBaht) > 1 And Right$(strThaiBaht, 5) = "หนึ่ง" Then
'// ตัดคำว่า "หนึ่ง" (มีความยาว 5 อักขระ) แล้วต่อท้ายด้วยคำว่า "เอ็ด"
strThaiBaht = Mid$(strThaiBaht, 1, Len(strThaiBaht) - 5) & "เอ็ด"
End If
' / --------------------------------------------------------------------------------------
'// หาค่าสตางค์ แต่ต้องเช็คก่อนว่ามีหน่วยสตางค์ด้วยหรือไม่
If strStang <> 0 Then
'// หาความยาวของสตางค์
'LenNum = Len(strStang)
'// กรณีสตางค์มีหลักเดียว ก็ใส่สิบตามหลังทันที
If Len(strStang) = 1 Then
strThaiStang = strThaiStang + ThaiDigit(Mid$(strStang, 1, 1)) + "สิบ"
Else
For i = 1 To Len(strStang)
If Mid$(strStang, i, 1) <> 0 Then
strThaiStang = strThaiStang + ThaiDigit(Mid(strStang, i, 1)) + arrUnit(Len(strStang) - i)
End If
Next
End If
End If
'// รวมบาทและสตางค์เข้าด้วยกัน
If strStang <> 0 Then
strThaiBaht = strThaiBaht + "บาท" + strThaiStang + "สตางค์"
Else
'// ไม่มีเศษสตางค์
strThaiBaht = strThaiBaht + "บาทถ้วน"
End If
'// ต้องเปลี่ยนคำบางคำเพื่อให้ตรงกับภาษาไทยก่อน
'// เมื่อค่าอินพุท คือ 321 ทำให้ได้ ...
'// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
'// "สองสิบ" จะเป็น "ยี่สิบ" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบหนึ่ง"
'// "สิบหนึ่ง" จะเป็น "สิบเอ็ด" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบเอ็ด"
'// หรือจะคิดที่คำว่า "สิบหนึ่ง" ก่อนก็จะได้คำตอบเหมือนเดิม
strThaiBaht = Replace(strThaiBaht, "หนึ่งสิบ", "สิบ")
strThaiBaht = Replace(strThaiBaht, "สิบหนึ่ง", "สิบเอ็ด")
strThaiBaht = Replace(strThaiBaht, "สองสิบ", "ยี่สิบ")
strThaiBaht = Replace(strThaiBaht, "ร้อยหนึ่ง", "ร้อยเอ็ด")
'// คืนค่ากลับ
'// คำตอบสุดท้าย คือ "สามร้อยยี่สิบเอ็ด"
'//MsgBox "ตัวเลข : " & strBaht & vbCrLf & strThaiBaht
NumberToThaiWord = strThaiBaht
End Function
' / --------------------------------------------------------------------------------------
'// ฟังค์ชั่นรับค่าตัวเลขแต่ละหลักเข้ามา และคืนค่ากลับเป็นภาษาไทย
Function ThaiDigit(Num As Byte) As String
Select Case Num
Case 0: ThaiDigit = "ศูนย์"
Case 1: ThaiDigit = "หนึ่ง"
Case 2: ThaiDigit = "สอง"
Case 3: ThaiDigit = "สาม"
Case 4: ThaiDigit = "สี่"
Case 5: ThaiDigit = "ห้า"
Case 6: ThaiDigit = "หก"
Case 7: ThaiDigit = "เจ็ด"
Case 8: ThaiDigit = "แปด"
Case 9: ThaiDigit = "เก้า"
End Select
End Function
' / --------------------------------------------------------------------------------------
' / ส่วนของเหตุการณ์ (Event) ในการดักการกดคีย์
Private Sub txtNumber_KeyPress(KeyAscii As Integer)
' / --------------------------------------------------------------------------------------
'/ ส่งค่าคีย์ที่กดไปตรวจสอบที่ฟังค์ชั่น และต้อง Return ค่ากลับมาด้วย
'/ ฟังค์ชั่นที่กดตัวเลข 0 - 9 และ . ทศนิยมสามารถมีได้เพียงจุดเดียวเท่านั้น
KeyAscii = CheckCurrency(KeyAscii, txtNumber)
End Sub
' / --------------------------------------------------------------------------------------
' / ฟังค์ชั่นที่ใช้ล็อคค่าการกดคีย์ และตรวจสอบเรื่องจุดทศนิยม
' / แต่เป็นการรับค่าแบบ Control หรือ Object แทน หรือ Pass By Reference
' / ซึ่งวิธีการนี้เราสามารถนำไปดัดแปลงใช้งานได้หลากหลาย ทำให้โปรแกรมของเรามีความยืดหยุ่น
Function CheckCurrency(Index As Integer, Ctrl As TextBox) As Integer
' / --------------------------------------------------------------------------------------
Select Case Index
Case 48 To 57
' 0 - 9 and Return index = KeyAscii
Case 8
' Back Space and Return index = KeyAscii
Case 13
' Enter and Return index = KeyAscii
Case 46 ' รหัส Ascii Codeของเครื่องหมายจุดครับพี่น้อง
If InStr(Ctrl, ".") Then Index = 0 ' ใช้ฟังค์ชั่น InStr (In String) เพื่อหาเครื่องหมายจุดใน TextBox
Case Else
Index = 0
End Select
CheckCurrency = Index ' Return ค่ากลับตามที่ได้ตรวจสอบ
End Function
' / --------------------------------------------------------------------------------------
'/แก้ปัญหาฟังค์ชั่น SendKeys ใน Windows 8 64 บิต
Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.shell")
WshShell.Sendkeys Text, Wait
Set WshShell = Nothing
End Sub
ดาวน์โหลดโค้ด VB6 ฉบับเต็มได้ที่นี่ ...
ขอบพระคุณมากครับผม:) ขอบคุณครับ
ขอบคุณครับ
หน้า:
[1]