ต้องการแปลงตัวเลขในรายงาน ของยอดรวมสุดท้าย ตย. เช่น รวมเป็นเงินทั้งสิ้น = 1,238.50 บาท แปลงเป็น>>> (หนึ่งพันสองร้อยสามสิบแปดบาทห้าสิบสตางค์)
ต้องเขียน Code อย่างไร? ช่วยชี้แนะด้วย จักขอบคุณยิ่ง
1. เขียน Function ไว้ที่ Module ตั้งชื่อ Module อะไรก็ได้
Function BahtText(InputCurrency As Currency) As String
Dim DigitSave, UnitSave, DigitName, DigitName1, UnitName, Satang, StrTmp, StrTmp1 As String
Dim DecimalValue, CurrDigit, PrevDigit, StrLen, DigitBase, ScanDigit As Integer
Dim IntegerValue As Double
' init variable
DigitName = "ศูนย์ หนึ่ง สอง สาม สี่ ห้า หก เจ็ด แปด เก้า" ' name of digit number
DigitName1 = "ยี่ สาม สี่ ห้า หก เจ็ด แปด เก้า" ' name of digit number in another call
UnitName = "แสน ล้าน สิบ ร้อย พัน หมื่น" ' name of digit base
BahtText = ""
Satang = ""
' check for negative val
If InputCurrency < 0 Then
InputCurrency = -InputCurrency
BahtText = "ลบ"
End If
StrTmp1 = Format(InputCurrency, "0.00") ' rounds up to 2 decimals
InputCurrency = Val(StrTmp1)
IntegerValue = Int(InputCurrency) ' get integer value
DecimalValue = (InputCurrency - IntegerValue) * 100 ' get 2 decimal values
' check for zeto val
If IntegerValue = 0 And DecimalValue = 0 Then
Satang = "ศูนย์บาทถ้วน"
GoTo locExit
End If
' translate integer val to name if necesary
If IntegerValue > 0 Then
StrTmp = Left(StrTmp1, Len(StrTmp1) - 3) ' get string of integer val
StrLen = Len(StrTmp) ' get string len
CurrDigit = 0
' scan integer string and compute its name
For ScanDigit = StrLen To 1 Step -1
' save previous digit
PrevDigit = CurrDigit
' get digit base
DigitBase = ScanDigit Mod 6
' convert digit character to numeric value
CurrDigit = Asc(Mid(StrTmp, StrLen - ScanDigit + 1, 1)) - 48
' get unit name from its base
UnitSave = RTrim(Mid(UnitName, DigitBase * 5 + 1, 5))
' get number name from Currdigit, depends on the digit base
DigitSave = RTrim(Mid(IIf(DigitBase = 2, DigitName1, DigitName), CurrDigit * 5 + 1, 5))
' base ten and number 1
If DigitBase = 1 And CurrDigit = 1 And PrevDigit <> 0 Then
DigitSave = "เอ็ด"
End If
' first digit base may be base million or 1
If DigitBase = 1 And ScanDigit < 6 Then
UnitSave = ""
End If
' ignore add digit name in result string if it is zero
If CurrDigit <> 0 Then
BahtText = BahtText + DigitSave + UnitSave
ElseIf DigitBase = 1 Then
BahtText = BahtText + UnitSave
End If
Next ScanDigit
BahtText = BahtText + "บาท"
End If
' if no decimal value
If DecimalValue = 0 Then
Satang = "ถ้วน"
' compute decimal val to name, there are only 2 digit
Else
StrTmp = Right(StrTmp1, 2)
' name ot first digit
CurrDigit = Asc(Left(StrTmp, 1)) - 48
PrevDigit = CurrDigit
If CurrDigit > 0 Then
Satang = RTrim(Mid(DigitName1, CurrDigit * 5 + 1, 5)) + "สิบ"
End If
' name of last digit
CurrDigit = Asc(Right(StrTmp, 1)) - 48
If CurrDigit > 0 Then
Satang = Satang + IIf(CurrDigit = 1 And PrevDigit <> 0, "เอ็ด", RTrim(Mid(DigitName, CurrDigit * 5 + 1, 5)))
End If
' store result and unit
Satang = Satang + "สตางค์"
End If
locExit:
' store result to BahtText
BahtText = BahtText + Satang
End Function
2. เขียนใช้ Function ที่ Form หรือ Report Footer เช่น
2.1 =("(" & (BahtText ([TextBoxName])) & ")")
2.2 =IIf(IsNull([TextBoxName]),"","(" & BahtText ([TextBoxName]) & ")")
function นี้สั้นๆ แต่ใช้ได้ดีทีเดียว ทดลองดูซิ:
Function BahtText(ByVal sNum)
Dim sNumber , sDigit , sDigit10
Dim nLen , sWord , sWord2
Dim sByte , I , J
sNumber = Array("", "หนึ่ง", "สอง", "สาม", "สี่", "ห้า", "หก", "เจ็ด", "แปด", "เก้า")
sDigit = Array("", "สิบ", "ร้อย", "พัน", "หมื่น", "แสน")
sDigit10 = Array("", "สิบ", "ยี่สิบ", "สามสิบ", "สี่สิบ", "ห้าสิบ", "หกสิบ", "เจ็ดสิบ", "แปดสิบ", "เก้าสิบ")
sNum = Replace(FormatNumber(sNum, 2), ",", "")
nLen = Len(sNum)
If sNum = ".00" Then BahtText = "ศูนย์"
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)
BahtText = BahtText & sWord
End If
If J = 0 And I <> nLen - 3 Then BahtText = BahtText & "ล้าน": BahtText = Replace(BahtText, "หนึ่งล้าน", "เอ็ดล้าน")
Next
If Left(sNum, 1) = "1" Then BahtText = Replace(BahtText, "เอ็ดล้าน", "หนึ่งล้าน")
If Left(sNum, 2) = "11" Then BahtText = Replace(BahtText, "สิบหนึ่งล้าน", "สิบเอ็ดล้าน")
If Len(BahtText) > 0 Then BahtText = BahtText & "บาท"
If nLen > 4 Then BahtText = Replace(BahtText, "หนึ่งบาท", "เอ็ดบาท")
sNum = Right(sNum, 2)
If sNum = "00" Then
BahtText = BahtText & "ถ้วน"
Else
If Left(sNum, 1) <> "0" Then BahtText = BahtText & sDigit10(Left(sNum, 1))
If Right(sNum, 1) <> "0" Then BahtText = BahtText & sNumber(Right(sNum, 1))
BahtText = BahtText & "สตางค์"
If Left(sNum, 1) <> "0" Then BahtText = Replace(BahtText, "หนึ่งสตางค์", "เอ็ดสตางค์")
End If
End Function
ผมมีแปลงเป็นภาษาอังกฤษครับ
***************************
ใน Text1 ใส่ข้อความลงใน Control Source : = ("-" & (NumToText([INV_Total])) & "-")
*****************************
Option Compare Database
Option Explicit
Function NumToText(dblValue As Double) As String
Static ones(0 To 9) As String
Static teens(0 To 9) As String
Static tens(0 To 9) As String
Static thousands(0 To 4) As String
Dim i As Integer, nPosition As Integer
Dim nDigit As Integer, bAllZeros As Integer
Dim strResult As String, strTemp As String
Dim tmpBuff As String
ones(0) = "zero"
ones(1) = "one"
ones(2) = "two"
ones(3) = "three"
ones(4) = "four"
ones(5) = "five"
ones(6) = "six"
ones(7) = "seven"
ones(8) = "eight"
ones(9) = "nine"
teens(0) = "ten"
teens(1) = "eleven"
teens(2) = "twelve"
teens(3) = "thirteen"
teens(4) = "fourteen"
teens(5) = "fifteen"
teens(6) = "sixteen"
teens(7) = "seventeen"
teens(8) = "eighteen"
teens(9) = "nineteen"
tens(0) = ""
tens(1) = "ten"
tens(2) = "twenty"
tens(3) = "thirty"
tens(4) = "forty"
tens(5) = "fifty"
tens(6) = "sixty"
tens(7) = "seventy"
tens(8) = "eighty"
tens(9) = "ninty"
thousands(0) = ""
thousands(1) = "thousand"
thousands(2) = "million"
thousands(3) = "billion"
thousands(4) = "trillion"
'Trap errors
On Error GoTo NumToTextError
'Get fractional part
'strResult = "and " & Format((dblValue - Int(dblValue)) * 100, "00") &"/100"
'strResult = "baht only)"
strResult = "only"
'Convert rest to string and process each digit
strTemp = CStr(Int(dblValue))
'Iterate through string
For i = Len(strTemp) To 1 Step -1
'Get value of this digit
nDigit = Val(Mid$(strTemp, i, 1))
'Get column position
nPosition = (Len(strTemp) - i) + 1
'Action depends on 1's, 10's or 100's column
Select Case (nPosition Mod 3)
Case 1 '1's position
bAllZeros = False
If i = 1 Then
tmpBuff = ones(nDigit) & " "
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = teens(nDigit) & " "
i = i - 1 'Skip tens position
ElseIf nDigit > 0 Then
tmpBuff = ones(nDigit) & " "
Else
'If next 10s & 100s columns are also
'zero, then don't show 'thousands'
bAllZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
bAllZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
bAllZeros = False
End If
End If
tmpBuff = ""
End If
If bAllZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & thousands(nPosition / 3) & " "
End If
strResult = tmpBuff & strResult
Case 2 'Tens position
If nDigit > 0 Then
strResult = tens(nDigit) & " " & strResult
End If
Case 0 'Hundreds position
If nDigit > 0 Then
strResult = ones(nDigit) & " hundred " & strResult
End If
End Select
Next i
'Convert first letter to upper case
If Len(strResult) > 0 Then
strResult = UCase$(Left$(strResult, 1)) & Mid$(strResult, 2)
End If
EndNumToText:
'Return result
NumToText = strResult
Exit Function
NumToTextError:
strResult = "#Error#"
Resume EndNumToText
End Function
**********************************************
Text = "(" & [TextA] & ")"
If Bill_total <> "" Then
Cancel = False
Text = "(" & [TextA] & ")"
Else
Cancel = True
บรรทัด1.SetFocus
End If
BahtText for MS Access: แปลงตัวเลขค่าเงินให้เป็นคำอ่านภาษาไทย
ถ้าใช้กับ ฟอร์ม,รายงาน เช่นใช้กับ TextBox, Combobox
- วิธีการ
1. สร้าง TextBox
2. คลิก 2 ครั้งที่ TextBox หรือที่ Property Sheet-->Data-->Control Source ของ TextBox ที่สร้างขึ้นมา แล้วพิมพ์ =BahtText([ฟิลด์ข้อมูลที่มีชนิดเป็น Currency])
หากใช้กับโค้ด VB
ตัวอย่างการใช้งาน
Private Sub testBahtText()
Dim strText as String
strText = BahtText(ชื่อตัวแปรหรือค่าตัวเลขชนิด Currency)
End Sub
Private Sub Command1_Click()
TextBox1 = BahtText(ชื่อตัวแปรหรือค่าตัวเลขชนิด Currency)
End Sub
