เพื่อมุ่งให้เกิดคุณภาพจากการอบรมสูงสุด Excel Expert Training ให้การอบรม Excel กลุ่มเล็กๆ ไม่เกิน 6 คนทุกคนสามารถเรียนรู้ Excel อย่างใกล้ชิด จะมาคนเดียวหรือมาเป็นกลุ่มแล้วนัดวันอบรมแบบส่วนตัวก็ได้ ผู้เข้าอบรมทุกคนสามารถติดตามเนื้อหาที่อบรมได้อย่างชัดเจนจากจอภาพด้านหน้าของตัวเอง
Results 1 to 2 of 2

Thread: มาร่วมพัฒนา Add-in สำหรับแปลงตัวเลขเป็นตัวอักษรกัน

  1. #1
    สมเกียรติ
    Guest

    มาร่วมพัฒนา Add-in สำหรับแปลงตัวเลขเป็นตัวอักษรกัน

    ไม่น่าเชื่อว่า Spelling Add-in ที่ผมไม่ได้เขียนรหัสเอง เพียงแค่นำรหัสที่ได้มาแก้ไขให้ใช้กับตัวเลขเงินของไทยให้อ่านตัวเลขเงินเป็นภาษาอังกฤษ จะได้รับการนำไปใช้อย่างแพร่หลาย ถือเป็นประโยชน์แก่สาธารณชนอย่างมาก

    ตอนแรกสร้าง BahtEng.xla ขึ้นมาแจก ก็มีคำแนะนำว่าพอตัวเลขไม่มีเศษ มันจะแสดงคำว่า and no satang ขึ้นมา ขอให้แสดงคำว่า only เลยได้ไหม ต่อมาผมจึงดัดแปลงใหม่กลายเป็น BahtOnly.xla

    จากนั้นผมได้ปรับปรุงให้ผู้ใช้งานสามารถใส่ชื่อหน่วยเงินได้เอง จะเป็น Baht Satang, Dollar Cent, Metre Centimetre ก็ได้ใน Money.xla โดยสร้างสูตรตามนี้
    =Money(Cellตัวเลข,"Baht","Satang")

    แฟ้มนี้แจกจ่ายไปสิบกว่าปีแล้วครับ น่าจะมีทางพัฒนาให้ดีขึ้นหรือใช้งานได้หลายแบบมากขึ้น จึงขอยกรหัสที่ผมใช้มาให้ช่วยดัดแปลงแก้ไขกัน ใครอยากได้แบบไหนก็ขอให้แจ้งมา ใครอยากอวดรหัสของตัวแล้วแจกแฟ้มที่ตัวสร้างก็เชิญครับ จะได้ช่วยกันสร้างประโยชน์ให้ชาวไทยกัน

    คุณอรวีร์เคยสร้าง Add-in อ่านเป็นภาษาไทยไว้ด้วยครับ ดูที่ http://www.excelexperttraining.com/g...rthaithai.html

    รหัสที่ผมใช้ใน Money.xla ตามนี้ครับ

    Code:
    Option Explicit
    
     '****************
     ' Main Function *
    ' Originated code from www.barasch.com
    ' กรณีไม่มีเศษ  จะแสดงคำว่า Only แทนคำว่า and No  Satang
     ' ตัวอย่าง =Money(123.45,"Baht","Satang")
     '****************
     Function Money(ByVal MyNumber, UnitName1, UnitName2)
     Dim KeyUnit1, KeyUnit2, Temp
     Dim DecimalPlace, Count
    
     ReDim Place(9) As String
     Place(2) = " Thousand "
     Place(3) = " Million "
     Place(4) = " Billion "
     Place(5) = " Trillion "
    
     ' String representation of amount
     MyNumber = Trim(Str(MyNumber))
    
     ' Position of decimal place 0 if none
     DecimalPlace = InStr(MyNumber, ".")
     'Convert KeyUnit2 and set MyNumber to KeyUnit1 amount
     If DecimalPlace > 0 Then
     KeyUnit2 = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
     MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
     End If
    
     Count = 1
     Do While MyNumber <> ""
     Temp = GetHundreds(Right(MyNumber, 3))
     If Temp <> "" Then KeyUnit1 = Temp & Place(Count) & KeyUnit1
     If Len(MyNumber) > 3 Then
     MyNumber = Left(MyNumber, Len(MyNumber) - 3)
     Else
     MyNumber = ""
     End If
     Count = Count + 1
     Loop
    
     Select Case KeyUnit1
     Case ""
     KeyUnit1 = "No " & UnitName1
     Case "One"
     KeyUnit1 = "One " & UnitName1
     Case Else
     KeyUnit1 = KeyUnit1 & " " & UnitName1 & "s"
     End Select
    
     Select Case KeyUnit2
     Case ""
     KeyUnit2 = " Only"
     Case "One"
     KeyUnit2 = " and One " & " " & UnitName2
     Case Else
     KeyUnit2 = " and " & KeyUnit2 & " " & UnitName2 & "s"
     End Select
    
     Money = KeyUnit1 & KeyUnit2
     End Function
    
     '*******************************************
     ' Converts a number from 100-999 into text *
     '*******************************************
     Private Function GetHundreds(ByVal MyNumber)
     Dim Result As String
    
     If Val(MyNumber) = 0 Then Exit Function
     MyNumber = Right("000" & MyNumber, 3)
    
     'Convert the hundreds place
     If Mid(MyNumber, 1, 1) <> "0" Then
     Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
     End If
    
     'Convert the tens and ones place
     If Mid(MyNumber, 2, 1) <> "0" Then
     Result = Result & GetTens(Mid(MyNumber, 2))
     Else
     Result = Result & GetDigit(Mid(MyNumber, 3))
     End If
    
     GetHundreds = Result
     End Function
    
     '*********************************************
     ' Converts a number from 10 to 99 into text. *
     '*********************************************
     Private Function GetTens(TensText)
     Dim Result As String
    
     Result = "" 'null out the temporary function value
     If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19
     Select Case Val(TensText)
     Case 10: Result = "Ten"
     Case 11: Result = "Eleven"
     Case 12: Result = "Twelve"
     Case 13: Result = "Thirteen"
     Case 14: Result = "Fourteen"
     Case 15: Result = "Fifteen"
     Case 16: Result = "Sixteen"
     Case 17: Result = "Seventeen"
     Case 18: Result = "Eighteen"
     Case 19: Result = "Nineteen"
     Case Else
     End Select
     Else ' If value between 20-99
     Select Case Val(Left(TensText, 1))
     Case 2: Result = "Twenty "
     Case 3: Result = "Thirty "
     Case 4: Result = "Forty "
     Case 5: Result = "Fifty "
     Case 6: Result = "Sixty "
     Case 7: Result = "Seventy "
     Case 8: Result = "Eighty "
     Case 9: Result = "Ninety "
     Case Else
     End Select
     Result = Result & GetDigit _
     (Right(TensText, 1)) 'Retrieve ones place
     End If
     GetTens = Result
     End Function
    
     '*******************************************
     ' Converts a number from 1 to 9 into text. *
     '*******************************************
     Private Function GetDigit(Digit)
     Select Case Val(Digit)
     Case 1: GetDigit = "One"
     Case 2: GetDigit = "Two"
     Case 3: GetDigit = "Three"
     Case 4: GetDigit = "Four"
     Case 5: GetDigit = "Five"
     Case 6: GetDigit = "Six"
     Case 7: GetDigit = "Seven"
     Case 8: GetDigit = "Eight"
     Case 9: GetDigit = "Nine"
     Case Else: GetDigit = ""
     End Select
     End Function
    ผมยังมี Add-in อื่นที่น่าจะเป็นประโยชน์ให้ download ไปใช้กันได้ที่ http://www.excelexperttraining.com/indexdownload.html
    และหน้านี้มีรหัสใน add-in ให้ศึกษากันครับ http://www.excelexperttraining.com/general/addin.html

  2. #2
    vajra
    Guest
    ลองฝึกเขียนตามความเข้าใจของตัวเองครับ
    ช่วยทดสอบด้วยครับ
    Code:
    Public Function eSpell(ByVal num As Variant, nDecimal As Byte, mainUnit As String, subUnit As String) As String
    Dim Decimals, intnumSpell
    mainUnit = " " & mainUnit & " "
    subUnit = " " & subUnit
    intnumSpell = Spellnum(Int(num)) & mainUnit
    intnumSpell = IIf(intnumSpell = mainUnit, "", intnumSpell)
    Decimals = Spellnum(Val(Right(num * 10 ^ nDecimal, nDecimal))) & subUnit
    Decimals = IIf(Decimals = subUnit, "Only", Decimals)
    eSpell = IIf(num = 0, "-", intnumSpell & Decimals)
    End Function
    
    
    Private Function Spellnum(ByVal num As Variant)
    Dim Arr, Arr1000, TextAll As String
    Arr1000 = Array("", " thousand ", " million ", " billion ", " trillion ")
    Intnum = Int(num)
    text = Format(Intnum, "* #,##0")
    Arr = Split(text, ",")
    n = UBound(Arr) - LBound(Arr)
    For i = 0 To n
     Arr(i) = Spell3Digits(Arr(i))
     TextAll = TextAll & Arr(i) & Arr1000(n - i)
    Next i
    Spellnum = UCase(TextAll)
    End Function
    
    
    Private Function Spell3Digits(ByVal num As Variant)
    Dim Intnum As Long, Numlen As Byte, Strnum As String
        Intnum = Int(num)
        Numlen = Len(Intnum)
        Stringnum = "0" & num
    For i = 1 To Numlen
       unit = Numlen + 1 - i
        Select Case unit
            Case 2: Unit2 = Spell(Evaluate(Left(Right(Stringnum, 2), 2)))
            Case 3: Unit3 = Spell(Evaluate(Left(Right(Stringnum, 3), 1))) & " hundred "
        End Select
    Next i
    Spell3Digits = IIf(Unit3 = " hundred ", "", Unit3) & Unit2
    End Function
    
    
    Private Function Spell(ByVal num As Variant)
        Select Case num
            Case 0: Spell = ""
            Case 1: Spell = "one"
            Case 2: Spell = "two"
            Case 3: Spell = "three"
            Case 4: Spell = "four"
            Case 5: Spell = "five"
            Case 6: Spell = "six"
            Case 7: Spell = "seven"
            Case 8: Spell = "eight"
            Case 9: Spell = "nine"
            Case 10: Spell = "ten"
            Case 11: Spell = "eleven"
            Case 12: Spell = "twelve"
            Case 13: Spell = "thirteen"
            Case 15: Spell = "fifteen"
            Case 18: Spell = "eighteen"
            Case 14, 16, 17, 19: Spell = Spell(Right(num, 1)) & "teen"
            Case 20: Spell = "twenty"
            Case 30: Spell = "thirty"
            Case 40: Spell = "fourty"
            Case 50: Spell = "fifty"
            Case 60: Spell = "sixty"
            Case 70: Spell = "seventy"
            Case 80: Spell = "eighty"
            Case 90: Spell = "ninety"
            Case 21 To 29, 31 To 39, 41 To 49, 51 To 59, 61 To 69, 71 To 79, 81 To 89, 91 To 99: _
            Spell = Spell(Left(num, 1) & "0") & "-" & Spell(Right(num, 1))
         End Select
    End Function

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •