본문 바로가기

카테고리 없음

spellnumber_usd 사용자 적용함수 매크로

반응형

엑셀에서 alt+f11 누르고 아래 모듈로 추가하면 됨




      '****************

      ' Main Function *

      '****************


      Function SpellNumber_USD(ByVal MyNumber)

          Dim DOLLARS, CENTS, 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 CENTS AND set MyNumber to dollar amount.

          If DecimalPlace > 0 Then

              CENTS = 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 DOLLARS = Temp & place(Count) & DOLLARS

              If Len(MyNumber) > 3 Then

                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)

              Else

                  MyNumber = ""

              End If

              Count = Count + 1

          Loop


          'Select Case DOLLARS

              'Case ""

                  'DOLLARS = "NO DOLLARS"

              'Case "ONE"

                  'DOLLARS = "ONE DOLLAR"

              'Case Else

                  'DOLLARS = DOLLARS & " DOLLARS"

          'End Select


          Select Case CENTS

              Case ""

                  CENTS = " AND NO CENTS"

              Case "ONE"

                  CENTS = " AND ONE Cent"

              Case Else

                  CENTS = " AND " & CENTS & " CENTS"

          End Select


          SpellNumber_USD = DOLLARS & CENTS

      End Function



      Function SpellNumber_JPY(ByVal MyNumber)

          Dim YEN, CENTS, 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 CENTS AND set MyNumber to dollar amount.

          If DecimalPlace > 0 Then

              CENTS = 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 YEN = Temp & place(Count) & YEN

              If Len(MyNumber) > 3 Then

                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)

              Else

                  MyNumber = ""

              End If

              Count = Count + 1

          Loop


          Select Case YEN

              Case ""

                  YEN = "NO YEN"

              Case "ONE"

                  YEN = "ONE YEN"

              Case Else

                  YEN = YEN & "YEN "

          End Select


          'Select Case CENTS

              'Case ""

                  'CENTS = " AND NO CENTS"

              'Case "ONE"

                  'CENTS = " AND ONE Cent"

              'Case Else

                  'CENTS = " AND " & CENTS & " CENTS"

          'End Select


          SpellNumber_JPY = YEN & CENTS

      End Function

      

      '*******************************************

      ' Converts a number from 100-999 into text *

      '*******************************************

      

      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. *

      '*********************************************


      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. *

      '*******************************************


      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