คำนวณออกมาเป็นตัวเลขแล้วอยากแปลงให้เป็นคำอ่านแบบตั
กระทู้เก่าบอร์ด อ.Yeadram

 1,494   2
URL.หัวข้อ / URL
คำนวณออกมาเป็นตัวเลขแล้วอยากแปลงให้เป็นคำอ่านแบบตั

พอดีว่าทำฟอร์มคำนวณยอดรวมทั้งหมดได้เป็นแบบตัวเลข
แต่พอดีว่าอยากให้แปลงเป็นคำอ่านออกมาเป็นตัวอักษร เช่น
24,610.00 เป็น twenty-four thousand six hundred ten and 00/100 baht

2 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R07969
code นี้เขียนโดยคุณ Joe Foster

' Convert a currency value into an (American) English string
Function NumToStringEnglish(ByVal n As Currency) As String
    Const Thousand = 1000@
    Const Million = Thousand * Thousand
    Const Billion = Thousand * Million
    Const Trillion = Thousand * Billion

    If (n = 0@) Then NumToStringEnglish = "zero": Exit Function

    Dim Buf As String: If (n < 0@) Then Buf = "negative " Else Buf = ""
    Dim Frac As Currency: Frac = Abs(n - Fix(n))
    If (n < 0@ Or Frac <> 0@) Then n = Abs(Fix(n))
    Dim AtLeastOne As Integer: AtLeastOne = n >= 1

    If (n >= Trillion) Then
        Debug.Print n
        Buf = Buf & EnglishDigitGroup(Int(n / Trillion)) & " trillion"
        n = n - Int(n / Trillion) * Trillion ' Mod overflows
        If (n >= 1@) Then Buf = Buf & " "
    End If
    
    If (n >= Billion) Then
        Debug.Print n
        Buf = Buf & EnglishDigitGroup(Int(n / Billion)) & " billion"
        n = n - Int(n / Billion) * Billion ' Mod still overflows
        If (n >= 1@) Then Buf = Buf & " "
    End If

    If (n >= Million) Then
        Debug.Print n
        Buf = Buf & EnglishDigitGroup(n \ Million) & " million"
        n = n Mod Million
        If (n >= 1@) Then Buf = Buf & " "
    End If

    If (n >= Thousand) Then
        Debug.Print n
        Buf = Buf & EnglishDigitGroup(n \ Thousand) & " thousand"
        n = n Mod Thousand
        If (n >= 1@) Then Buf = Buf & " "
    End If

    If (n >= 1@) Then
        Debug.Print n
        Buf = Buf & EnglishDigitGroup(n)
    End If

    If (Frac = 0@) Then
        Buf = Buf & " exactly"
    ElseIf (Int(Frac * 100@) = Frac * 100@) Then
        If AtLeastOne Then Buf = Buf & " and "
        Buf = Buf & Format$(Frac * 100@, "00") & "/100"
    Else
        If AtLeastOne Then Buf = Buf & " and "
        Buf = Buf & Format$(Frac * 10000@, "0000") & "/10000"
    End If

    NumToStringEnglish = Buf
End Function

' Support function to be used only by English()
Private Function EnglishDigitGroup(ByVal n As Integer) As String
    Const Hundred = " hundred"
    Const One = "one"
    Const Two = "two"
    Const Three = "three"
    Const Four = "four"
    Const Five = "five"
    Const Six = "six"
    Const Seven = "seven"
    Const Eight = "eight"
    Const Nine = "nine"
    Dim Buf As String: Buf = ""
    Dim Flag As Integer: Flag = False

    'Do hundreds
    Select Case (n \ 100)
    Case 0: Buf = "": Flag = False
    Case 1: Buf = One & Hundred: Flag = True
    Case 2: Buf = Two & Hundred: Flag = True
    Case 3: Buf = Three & Hundred: Flag = True
    Case 4: Buf = Four & Hundred: Flag = True
    Case 5: Buf = Five & Hundred: Flag = True
    Case 6: Buf = Six & Hundred: Flag = True
    Case 7: Buf = Seven & Hundred: Flag = True
    Case 8: Buf = Eight & Hundred: Flag = True
    Case 9: Buf = Nine & Hundred: Flag = True
    End Select
   
    If (Flag <> False) Then n = n Mod 100
    If (n > 0) Then
        If (Flag <> False) Then Buf = Buf & " "
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If
      
    'Do tens (except teens)
    Select Case (n \ 10)
    Case 0, 1: Flag = False
    Case 2: Buf = Buf & "twenty": Flag = True
    Case 3: Buf = Buf & "thirty": Flag = True
    Case 4: Buf = Buf & "forty": Flag = True
    Case 5: Buf = Buf & "fifty": Flag = True
    Case 6: Buf = Buf & "sixty": Flag = True
    Case 7: Buf = Buf & "seventy": Flag = True
    Case 8: Buf = Buf & "eighty": Flag = True
   
    Case 9: Buf = Buf & "ninety": Flag = True
    End Select
    If (Flag <> False) Then n = n Mod 10
    If (n > 0) Then
        If (Flag <> False) Then Buf = Buf & "-"
    Else
        EnglishDigitGroup = Buf
        Exit Function
    End If
    
    'Do ones and teens
    Select Case (n)
    Case 0: ' do nothing
    Case 1: Buf = Buf & One
    Case 2: Buf = Buf & Two
    Case 3: Buf = Buf & Three
    Case 4: Buf = Buf & Four
    Case 5: Buf = Buf & Five
    Case 6: Buf = Buf & Six
    Case 7: Buf = Buf & Seven
    Case 8: Buf = Buf & Eight
    Case 9: Buf = Buf & Nine
    Case 10: Buf = Buf & "ten"
    Case 11: Buf = Buf & "eleven"
    Case 12: Buf = Buf & "twelve"
    Case 13: Buf = Buf & "thirteen"
    Case 14: Buf = Buf & "fourteen"
    Case 15: Buf = Buf & "fifteen"
    Case 16: Buf = Buf & "sixteen"
    Case 17: Buf = Buf & "seventeen"
    Case 18: Buf = Buf & "eighteen"
    Case 19: Buf = Buf & "nineteen"
    End Select

    EnglishDigitGroup = Buf
End Function

นำ code นี้ไว้ที่ Module

ที่ Control ที่ ต้องการแสดง คำอ่านภาษาอังกฤษ
กำหนด control source =NumToStringEnglish(ค่าเงินที่ต้องการแปลง หรือ control ที่เก็บค่าเงินที่ต้องการแปลง)
2 @R07970
ขอบคุณค่ะจะลองน้ำไปใช้ดูค่ะ
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.3196s