กระทู้เก่าบอร์ด อ.Yeadram
33,767 31
URL.หัวข้อ /
URL
การแปลงตัวเลขเป็นตัวอักษร
ต้องการแปลงตัวเลขในรายงาน ของยอดรวมสุดท้าย ตย. เช่น รวมเป็นเงินทั้งสิ้น = 1,238.50 บาท แปลงเป็น>>> (หนึ่งพันสองร้อยสามสิบแปดบาทห้าสิบสตางค์)
ต้องเขียน Code อย่างไร? ช่วยชี้แนะด้วย จักขอบคุณยิ่ง
ต้องเขียน Code อย่างไร? ช่วยชี้แนะด้วย จักขอบคุณยิ่ง
31 Reply in this Topic. Dispaly 2 pages and you are on page number 1
2 @R00785
ขอบคุณครับ K. jackychaan
ผมจะลองพยายามทำดู ...เพื่อว่าใบเสร็จรับเงินของผมจะได้สมบูรณ์ยิ่งขึ้น
เพราะปัจจุบัน ต้องใช้วิธี คีย์ตัวอักษรลงไปเองตามผลรวมตัวเลข
ก่อนพิมพ์ออกใบเสร็จรับเงิน
ผมจะลองพยายามทำดู ...เพื่อว่าใบเสร็จรับเงินของผมจะได้สมบูรณ์ยิ่งขึ้น
เพราะปัจจุบัน ต้องใช้วิธี คีย์ตัวอักษรลงไปเองตามผลรวมตัวเลข
ก่อนพิมพ์ออกใบเสร็จรับเงิน
3 @R00831
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
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
4 @R01575
ส่วนอันนี้อ้างอิง function ของ excel ครับ
Function BahttextExcel(Value As Double) As String
BahttextExcel = WorksheetFunction.BahtText(Value)
End Function
เอามาจาก web อ.สุภาพอีกแล้วครับท่าน
Function BahttextExcel(Value As Double) As String
BahttextExcel = WorksheetFunction.BahtText(Value)
End Function
เอามาจาก web อ.สุภาพอีกแล้วครับท่าน
5 @R01622
ผมมีแปลงเป็นภาษาอังกฤษครับ
***************************
ใน 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
**********************************************
***************************
ใน 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
**********************************************
6 @R03440
ผมอยากจะแปลงตัวเลขภาษาอังกฤษเป็นตัวเขียนใน Excel คับ เช่นจำนวนเงิน 1000.50 (One thousands and 50/100) มีให้ดาวน์โหลดตรงไหนคับ
7 @R03607
ขอบคุณมากครับ ได้ตรงนี้เอาไปช่วยในรายงานได้เยอะมากๆเลย ขอบคุณทุกๆคนมากครับ
8 @R06120
ทำไมผมทำแล้วขึ้น #name?
9 @R06121
ได้แล้ว ขอบคุณคร้าบ
10 @R08893
ถ้าต้องการ ภาษาอังกฤษที่มี satang ด้วยอ่ะครับ แก้ตรงไหนครับ ขอบคุณครับ
11 @R08905
ไม่ทราบว่า เวลาจะใช้ฟังชั่นต้องนำไปวางไว้ที่ไหน อย่างไรครับ รบกวนด้วยครับมือใหม่ ไม่ทราบจริงๆครับ
12 @R08906
ไปที่โมดูลครับ จากนั้นให้ Copy Code ไปวางไว้ในโมดูล แล้วเซฟเป็นชื่ออะไรก็ได้ เวลาจะเรียกใช้งานก็ให้เรียกใช้งานจากชื่อฟังก์ชั่นนั้นๆ
เช่น Function BahtText เวลาจะใช้งาน สมมุติเรียกใช้ผ่านคิวรี่ ก็ให้ ใส่ชื่อฟังก์ชั่น BahtText(ชื่อ Field) ครับ
เช่น Function BahtText เวลาจะใช้งาน สมมุติเรียกใช้ผ่านคิวรี่ ก็ให้ ใส่ชื่อฟังก์ชั่น BahtText(ชื่อ Field) ครับ
13 @R08907
ขอบคุณมากครับท่านอาจารย์ Sak
14 @R08908
ขอบคุณค่ะมาก ท่านอาจารย์ Sak
15 @R10468
Function เหล่านี้ ให้ส่ที่ตรงไหนคะ
16 @R10469
ขอถามใหม่ว่าโมดูล ตรง Property หรือเปล่าค่ะ
ให้ใส่ที่ฟอร์ม หรือ Report คะ
ให้ใส่ที่ฟอร์ม หรือ Report คะ
17 @R10470
ถ้าตั้งใจจะใช้ในฟอร์มก็วางโค้ดไว้ในโมดูลของฟอร์ม แต่ถ้าต้องการใช้ทุกที่ทุกเวลาก็วางไว้ใน AIS Module
-วิธีการ-
1.ในมุมมอง Visual Basic ให้คลิกเลือก Insert-->Modules
2.วางโค้ดที่คัดลอกจากบอร์ดนี้
3.คลิกเมนู Debug-->Compile...
4.บันทึก
-วิธีการ-
1.ในมุมมอง Visual Basic ให้คลิกเลือก Insert-->Modules
2.วางโค้ดที่คัดลอกจากบอร์ดนี้
3.คลิกเมนู Debug-->Compile...
4.บันทึก
18 @R10472
ขออุญาต ถามต่อนะคะว่า ได้ทำตามขั้นตอนแล้ว
แล้วจะให้มันแสดงตัวเลขเป็นตัวอักษรอย่างไร
ขอถามขั้นตอนการทำเพิ่มคะ
***ต้องขอโทษที่ถามเพิ่มเนื่องจากไม่ทราบจริงๆคะ
แล้วจะให้มันแสดงตัวเลขเป็นตัวอักษรอย่างไร
ขอถามขั้นตอนการทำเพิ่มคะ
***ต้องขอโทษที่ถามเพิ่มเนื่องจากไม่ทราบจริงๆคะ
19 @R10473
ถ้าใช้กับ ฟอร์ม,รายงาน เช่นใช้กับ 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
- วิธีการ
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
20 @R10484
ได้ทำตามขั้นตอนแล้วมันแสดง #Error ที่ Text Box
จะแก้ขอย่างไรดีค่ะ
จะแก้ขอย่างไรดีค่ะ
Time: 0.3492s
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]) & ")")