[VB6/VBA/VB.Net] การแปลงจำนวนเงินเป็นข้อความภาษาไทย

thongkorn

ยกมาทั้งตระกูล Visual Basic กันเลยทีเดียว แต่ทว่าโค้ดที่แอดมินจะแจกนี้ เขียนเป็น ฟังค์ชั่นในการแปลงเอาไว้ให้อยู่ใน VB6 ที่เหลือก็ตัดแปะนำไปใช้งานกันเอาตามสบายครับ ซึ่งสามารถรองรับจำนวนตัวเลขระดับล้านล้านได้ เว่อร์วังอลังการมาก คำอธิบายจะอยู่ในโค้ด ซึ่งแอดมินพยายามแจกแจงอธิบายรายละเอียดยิบกันเลยทีเดียว ...

มาดูโค้ดกันเถอะ ...

1. ' / --------------------------------------------------------------------------------------
   
2. ' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
   
3. ' / eMail : thongkorn@hotmail.com
   
4. ' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
   
5. ' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
   
6. ' / Facebook: https://www.facebook.com/commonindy (Worldwide)
   
7. ' / Purpose : Convert numerical to Thai word.
   
8. ' / Microsoft Visual Basic 6.0 (SP6)
   
9. ' /
   
10. ' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
    
11. ' / You can modify and/or distribute without to inform the developer.
    
12. ' / --------------------------------------------------------------------------------------
    
13. Option Explicit
    
14. 
    
15. ' / --------------------------------------------------------------------------------------
    
16. Private Sub cmdConvert_Click()
    
17.     txtThaiWord.Text = "" ' เคลียร์ค่าผลลัพธ์
    
18.     txtThaiWord.Text = NumberToThaiWord(txtNumber.Text)
    
19. End Sub
    
20. 
    
21. ' / --------------------------------------------------------------------------------------
    
22. Private Sub Form_Load()
    
23.     txtNumber.Text = "9999999999101" '"365001.23"
    
24.     txtThaiWord.Text = ""
    
25. End Sub
    
26. 
    
27. ' / --------------------------------------------------------------------------------------
    
28. ' / ฟังค์ชั่นในการแปลงตัวเลขให้เป็นจำนวนภาษาไทย
    
29. ' / การเรียกใช้งาน :ให้ส่งค่ามาแบบ String
    
30. ' / NumberToThaiWord("1234.55")
    
31. ' / NumberToThaiWord(ตัวแปร)
    
32. Function NumberToThaiWord(strNumber As String) As String
    
33. ' / --------------------------------------------------------------------------------------
    
34.     Dim strThaiBaht  As String
    
35.     Dim strThaiStang As String
    
36.     '// คำประจำหลัก
    
37.     Dim arrUnit(6) As String
    
38.     arrUnit(0) = ""
    
39.     arrUnit(1) = "สิบ"
    
40.     arrUnit(2) = "ร้อย"
    
41.     arrUnit(3) = "พัน"
    
42.     arrUnit(4) = "หมื่น"
    
43.     arrUnit(5) = "แสน"
    
44.     arrUnit(6) = "ล้าน"
    
45.     '// แยกเงินบาทกับสตางค์ออกจากกันด้วยเครื่องหมายทศนิยม
    
46.     Dim strBaht As String, strStang As String
    
47.     Dim arrNum As Variant
    
48.     '// เช็คว่ามีจุดทศนิยมด้วยหรือไม่
    
49.     If InStr(strNumber, ".") <> 0 Then
    
50.         arrNum = Split(strNumber, ".")
    
51.         '// บาท
    
52.         strBaht = CDbl(arrNum(0))
    
53.         '// สตางค์
    
54.         strStang = arrNum(1)
    
55.     Else
    
56.         strBaht = CDbl(strNumber)
    
57.         strStang = 0
    
58.     End If
    
59.    
    
60.     Dim i As Byte
    
61.     '// หาหลักล้าน
    
62.     Dim Million As Byte
    
63.     If (Len(strBaht) >= 7) Then
    
64.         Million = Len(strBaht) - 6
    
65.         '/ หาหลักที่เกินล้าน
    
66.         For i = 1 To Million
    
67.             If Mid$(strBaht, i, 1) <> 0 Then strThaiBaht = strThaiBaht + ThaiDigit(Mid$(strBaht, i, 1)) + arrUnit(Million - i)
    
68.         Next
    
69.         strThaiBaht = strThaiBaht + "ล้าน"
    
70.     End If
    
71.    
    
72.     '// หาเงินส่วนที่ไม่เกินล้าน
    
73.     'strBaht = Trim(Right(arrNum(0), 6))
    
74.     strBaht = Trim(Right(strBaht, 6))
    
75.     '// คิดจำนวนเต็มก่อน
    
76.     For i = 1 To Len(strBaht)
    
77.         '// ดักค่าก่อนว่าหลักนั้นๆต้องมีค่าไม่ใช่ 0 เพื่อไม่ให้มีคำประจำหลักติดมา เช่น ...
    
78.         '// 301 จะต้องข้ามหลักสิบไป
    
79.         If Mid$(strBaht, i, 1) <> 0 Then
    
80.             '// วิธีการคิด ...
    
81.             '// ThaiDigit(Mid$(strBaht, i, 1)) คือ การรับค่าตัวเลขทีละหลักจากซ้ายไปขวา แล้วส่งไปเทียบค่าภาษาไทย
    
82.             '// เช่น 321
    
83.             '// รอบที่ 1 เมื่อ i = 1 ก็เลือกเอาเฉพาะหลักซ้ายมือสุด Mid("321", 1, 1) = 1 ตรงกับ "สาม"
    
84.             '// รอบที่ 2 เมื่อ i = 2 ก็เลือกเอาเฉพาะหลักที่สอง Mid("321", 2, 1) = 2 ตรงกับ "สอง"
    
85.             '// รอบที่ 3 เมื่อ i = 3 ก็เลือกเอาเฉพาะหลักที่สาม Mid("321", 3, 1) = 1 ตรงกับ "หนึ่ง"
    
86.             
    
87.             '// arrUnit(Len(strBaht) - i) คือ คำประจำหลัก
    
88.             '// เช่น 321 มีความยาว หรือ Len(strBaht) = 3
    
89.             '// รอบที่ 1 เมื่อ i = 1 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 1 ตรงกับ arrUnit(2) = "ร้อย"
    
90.             '// รอบที่ 2 เมื่อ i = 2 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 2 ตรงกับ arrUnit(1) = "สิบ"
    
91.             '// รอบที่ 3 เมื่อ i = 3 ก็เอา Len(strBaht)= 3 ลบออกจากค่า i = 3 ตรงกับ arrUnit(0) = "" (หลักหน่วยปล่อยว่าง)
    
92.             strThaiBaht = strThaiBaht & ThaiDigit(Mid$(strBaht, i, 1)) & arrUnit(Len(strBaht) - i)
    
93.             '// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
    
94.         End If
    
95.     Next
    
96.     '// คำสุดท้ายคือคำลงท้ายด้วย "หนึ่ง" สำหรับการอ่านตัวเลขมากกว่า 2 หลักขึ้นไป
    
97.     '// เช่น 1001, 5001, 65001
    
98.     If Len(strBaht) > 1 And Right$(strThaiBaht, 5) = "หนึ่ง" Then
    
99.         '// ตัดคำว่า "หนึ่ง" (มีความยาว 5 อักขระ) แล้วต่อท้ายด้วยคำว่า "เอ็ด"
    
100.         strThaiBaht = Mid$(strThaiBaht, 1, Len(strThaiBaht) - 5) & "เอ็ด"
     
101.     End If
     
102.    
     
103.     ' / --------------------------------------------------------------------------------------
     
104.     '// หาค่าสตางค์ แต่ต้องเช็คก่อนว่ามีหน่วยสตางค์ด้วยหรือไม่
     
105.     If strStang <> 0 Then
     
106.         '// หาความยาวของสตางค์
     
107.         'LenNum = Len(strStang)
     
108.         '// กรณีสตางค์มีหลักเดียว ก็ใส่สิบตามหลังทันที
     
109.         If Len(strStang) = 1 Then
     
110.             strThaiStang = strThaiStang + ThaiDigit(Mid$(strStang, 1, 1)) + "สิบ"
     
111.         Else
     
112.             For i = 1 To Len(strStang)
     
113.                 If Mid$(strStang, i, 1) <> 0 Then
     
114.                     strThaiStang = strThaiStang + ThaiDigit(Mid(strStang, i, 1)) + arrUnit(Len(strStang) - i)
     
115.                 End If
     
116.             Next
     
117.         End If
     
118.     End If
     
119.    
     
120.     '// รวมบาทและสตางค์เข้าด้วยกัน
     
121.     If strStang <> 0 Then
     
122.         strThaiBaht = strThaiBaht + "บาท" + strThaiStang + "สตางค์"
     
123.     Else
     
124.         '// ไม่มีเศษสตางค์
     
125.         strThaiBaht = strThaiBaht + "บาทถ้วน"
     
126.     End If
     
127.    
     
128.     '// ต้องเปลี่ยนคำบางคำเพื่อให้ตรงกับภาษาไทยก่อน
     
129.     '// เมื่อค่าอินพุท คือ 321 ทำให้ได้ ...
     
130.     '// strThaiBaht = "สามร้อยสองสิบหนึ่ง"
     
131.     '// "สองสิบ" จะเป็น "ยี่สิบ" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบหนึ่ง"
     
132.     '// "สิบหนึ่ง" จะเป็น "สิบเอ็ด" ทำให้ได้คำใหม่ คือ "สามร้อยยี่สิบเอ็ด"
     
133.     '// หรือจะคิดที่คำว่า "สิบหนึ่ง" ก่อนก็จะได้คำตอบเหมือนเดิม
     
134.     strThaiBaht = Replace(strThaiBaht, "หนึ่งสิบ", "สิบ")
     
135.     strThaiBaht = Replace(strThaiBaht, "สิบหนึ่ง", "สิบเอ็ด")
     
136.     strThaiBaht = Replace(strThaiBaht, "สองสิบ", "ยี่สิบ")
     
137.     strThaiBaht = Replace(strThaiBaht, "ร้อยหนึ่ง", "ร้อยเอ็ด")
     
138.     '// คืนค่ากลับ
     
139.     '// คำตอบสุดท้าย คือ "สามร้อยยี่สิบเอ็ด"
     
140.     '//MsgBox "ตัวเลข : " & strBaht & vbCrLf & strThaiBaht
     
141.     NumberToThaiWord = strThaiBaht
     
142. End Function
     
143. 
     
144. ' / --------------------------------------------------------------------------------------
     
145. '// ฟังค์ชั่นรับค่าตัวเลขแต่ละหลักเข้ามา และคืนค่ากลับเป็นภาษาไทย
     
146. Function ThaiDigit(Num As Byte) As String
     
147.     Select Case Num
     
148.         Case 0: ThaiDigit = "ศูนย์"
     
149.         Case 1: ThaiDigit = "หนึ่ง"
     
150.         Case 2: ThaiDigit = "สอง"
     
151.         Case 3: ThaiDigit = "สาม"
     
152.         Case 4: ThaiDigit = "สี่"
     
153.         Case 5: ThaiDigit = "ห้า"
     
154.         Case 6: ThaiDigit = "หก"
     
155.         Case 7: ThaiDigit = "เจ็ด"
     
156.         Case 8: ThaiDigit = "แปด"
     
157.         Case 9: ThaiDigit = "เก้า"
     
158.     End Select
     
159. End Function
     
160. 
     
161. ' / --------------------------------------------------------------------------------------
     
162. ' / ส่วนของเหตุการณ์ (Event) ในการดักการกดคีย์
     
163. Private Sub txtNumber_KeyPress(KeyAscii As Integer)
     
164. ' / --------------------------------------------------------------------------------------
     
165.     '/ ส่งค่าคีย์ที่กดไปตรวจสอบที่ฟังค์ชั่น และต้อง Return ค่ากลับมาด้วย
     
166.     '/ ฟังค์ชั่นที่กดตัวเลข 0 - 9 และ . ทศนิยมสามารถมีได้เพียงจุดเดียวเท่านั้น
     
167.     KeyAscii = CheckCurrency(KeyAscii, txtNumber)
     
168. End Sub
     
169. 
     
170. ' / --------------------------------------------------------------------------------------
     
171. ' / ฟังค์ชั่นที่ใช้ล็อคค่าการกดคีย์ และตรวจสอบเรื่องจุดทศนิยม
     
172. ' / แต่เป็นการรับค่าแบบ Control หรือ Object แทน หรือ Pass By Reference
     
173. ' / ซึ่งวิธีการนี้เราสามารถนำไปดัดแปลงใช้งานได้หลากหลาย ทำให้โปรแกรมของเรามีความยืดหยุ่น
     
174. Function CheckCurrency(Index As Integer, Ctrl As TextBox) As Integer
     
175. ' / --------------------------------------------------------------------------------------
     
176.     Select Case Index
     
177.         Case 48 To 57
     
178.             ' 0 - 9 and Return index = KeyAscii
     
179.         Case 8
     
180.             ' Back Space and Return index = KeyAscii
     
181.         Case 13
     
182.             ' Enter and Return index = KeyAscii
     
183.         Case 46 ' รหัส Ascii Code  ของเครื่องหมายจุดครับพี่น้อง
     
184.             If InStr(Ctrl, ".") Then Index = 0 ' ใช้ฟังค์ชั่น InStr (In String) เพื่อหาเครื่องหมายจุดใน TextBox
     
185.         Case Else
     
186.             Index = 0
     
187.     End Select
     
188.     CheckCurrency = Index ' Return ค่ากลับตามที่ได้ตรวจสอบ
     
189. End Function
     
190. 
     
191. ' / --------------------------------------------------------------------------------------
     
192. '/  แก้ปัญหาฟังค์ชั่น SendKeys ใน Windows 8 64 บิต
     
193. Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
     
194.     Dim WshShell As Object
     
195.     Set WshShell = CreateObject("Wscript.shell")
     
196.     WshShell.Sendkeys Text, Wait
     
197.     Set WshShell = Nothing
     
198. End Sub

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ด VB6 ฉบับเต็มได้ที่นี่ ...

MrDen

ขอบพระคุณมากครับผม

jaricha5

ขอบคุณครับ

g2gsoftuser

ขอบคุณครับ