กระทู้เก่าบอร์ด อ.Yeadram
3,432 6
URL.หัวข้อ /
URL
ขอวิธีแปลงตัวเลขเป็นตัวอักษรภาอังกฤษแบบมีเศษสตางค์
รบกวนขอ Code แปลง ตัวเลข เป็นอักษร ภาษา อังกฤษ แบบมีเศษสตางค์ด้วยค่ะ หายังไงก็หาไม่เจออออ รบกวน ผู้รู้ แนะนำด้วยนะค่ะ ขอบคุณมากๆๆๆค่ะ
6 Reply in this Topic. Dispaly 1 pages and you are on page number 1
2 @R12796
รบกวนด้วยนะค่ะ ต้องใช้ทำงาน แต่ยังหา Code ไม่ได้เลย ค่ะ :(
3 @R12797
comment line นี้ออกครับ
strResult = "only"
แล้วเพิ่ม code นี้เข้าไปครับ
Public Function BahtText(dblValue As Double) As String
Dim strResult As String
Dim lngSatng As Long
strResult = NumToText(Int(dblValue))
lngSatng = dblValue * 100 Mod 100
If lngSatng > 0 Then
strResult = strResult & "and " & NumToText(dblValue * 100 Mod 100) & "Satang"
Else
strResult = strResult & "baht only"
End If
BahtText = strResult
End Function
strResult = "only"
แล้วเพิ่ม code นี้เข้าไปครับ
Public Function BahtText(dblValue As Double) As String
Dim strResult As String
Dim lngSatng As Long
strResult = NumToText(Int(dblValue))
lngSatng = dblValue * 100 Mod 100
If lngSatng > 0 Then
strResult = strResult & "and " & NumToText(dblValue * 100 Mod 100) & "Satang"
Else
strResult = strResult & "baht only"
End If
BahtText = strResult
End Function
4 @R12801
ขอบคุณมากๆ นะค่ะ คุณ PichaiTC พอลบแล้ว แล้วมันก็ยังไม่ได้อะค่ะ
ลบตรงสีแดงออกแล้ว เพิ่มเข้าไปตรงนี้ถูกไหมค่ะ ช่วยแนะนำหน่อยค่ะ ขอบคุณมากค่ะ
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
ลบตรงสีแดงออกแล้ว เพิ่มเข้าไปตรงนี้ถูกไหมค่ะ ช่วยแนะนำหน่อยค่ะ ขอบคุณมากค่ะ
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
5 @R12802
แล้วเพิ่ม code
Public Function BahtText(dblValue As Double) As String
...
เข้าไปหรือยังเครับ
เวลาเรียกใช้
= BahtText(...) แทน NumToText()
หรือใช้ function จากคุณ yeadram แทนเลยก็ได้ครับ
Public Function BahtText(dblValue As Double) As String
...
เข้าไปหรือยังเครับ
เวลาเรียกใช้
= BahtText(...) แทน NumToText()
หรือใช้ function จากคุณ yeadram แทนเลยก็ได้ครับ
6 @R12804
เรียบร้อยแล้วค่ะ ขอบคุณมากๆนะค่ะ คุณ PichaiTC รบกวนช่วยให้คำปรึกษา อีกเรื่องนึงได้ไหมค่ะ ในกระทู้ อีกอันอะค่ะ ที่ชื่อว่า รบกวนถามผู้รุ้ เรื่อง ภาษา ค่ะ ขอบคุณค่ะ
Time: 0.3175s
ขอบคุณมากๆ ค่ะ
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