MS ACCESS大问题来了~请问谁会做这种的数目CONVERTER去文字。

程家伟

我这里有个PROJECT如何的把数目CONVERT去文字。。

例如：1，234 然后的答案再REPORT里是1，234和ONE THOUSAN TWO HUNDREN AND THIRTY FOUR 的字之类。。

然后我的好老板要我今晚内搞定。。。。各位大大，请各位教教小弟了

[ 本帖最后由 程家伟 于 29-8-2006 03:53 PM 编辑 ]

goatstudio

看这里: http://www.ozgrid.com/VBA/CurrencyToWords.htm

虽然是 Excel, 但一样的原理... 还是用 VBA 的.

程家伟

原帖由 goatstudio 于 29-8-2006 03:57 PM 发表
看这里: http://www.ozgrid.com/VBA/CurrencyToWords.htm

虽然是 Excel, 但一样的原理... 还是用 VBA 的.

我先看看，不会再上来找你们。。。因为刚才我出去办东西。。谢谢你了GOATSTUDIO兄

程家伟

我看过了，可是要如何的开始？没有头绪。。

还是不能做到？！！！要怎样呢？我试过用textbox来做，然后在event里on mouse move选event proceduce。。 然后就把所有的coding都丢下去。。。可是没有result了。。惨

[ 本帖最后由 程家伟 于 29-8-2006 06:48 PM 编辑 ]

goatstudio

原帖由 程家伟 于 29-8-2006 04:27 PM 发表
我看过了，可是要如何的开始？没有头绪。。

还是不能做到？！！！要怎样呢？我试过用textbox来做，然后在event里on mouse move选event proceduce。。 然后就把所有的coding都丢下去。。。可是没有result了 ...

你连 coding 都没写出来... 什么问题也说不出来...
有谁能帮你呢?

程家伟

原帖由 goatstudio 于 29-8-2006 08:30 PM 发表


你连 coding 都没写出来... 什么问题也说不出来...
有谁能帮你呢?

呵呵，不好意思，我在想这个方法是在report里面写的吗？还是在form里就可以启动了？
我在这里简单的放两个加起来的textbox。。然后total是用query来把两个textbox加了起来。

例如：MyNumber:[num1]+[num2]

然后我在我的form里的propeties，在event选项我因该要选什么呢？？

程家伟

各位大大，， 小弟跪求大家行个好。。。我不知怎么开头了。。。。到了现在还是写不出来了。。。伤心潦倒。。。。。。我也看过了goatstudio兄的link code 了。。。就是不知道要把它摆放在那里的部分。。。然后的output 有不知去向？？？这次惨了。。。好大压力。。。

ps: goatstudio兄，看来我白费你的心机了。。先说声对不起了

程家伟

Function ConvertCurrencyToEnglish(ByVal MyNumber)
         Dim Temp
         Dim Dollars, Cents
         Dim DecimalPlace, Count

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, "."

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If

         Count = 1
         Do While MyNumber <> ""
            ' Convert last 3 digits of MyNumber to English dollars.
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
               ' Remove last 3 converted digits from MyNumber.
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop

         ' Clean up dollars.
         Select Case Dollars
            Case ""
               Dollars = "No Dollars"
            Case "One"
               Dollars = "One Dollar"
            Case Else
               Dollars = Dollars & " Dollars"
         End Select

         ' Clean up cents.
         Select Case Cents
            Case ""
               Cents = " And No Cents"
            Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select

         ConvertCurrencyToEnglish = Dollars & Cents
      End Function



     Private Function ConvertHundreds(ByVal MyNumber)
         Dim Result As String

         ' Exit if there is nothing to convert.
         If Val(MyNumber) = 0 Then Exit Function

         ' Append leading zeros to number.
         MyNumber = Right("000" & MyNumber, 3)

         ' Do we have a hundreds place digit to convert?
         If Left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
         End If

         ' Do we have a tens place digit to convert?
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If

         ConvertHundreds = Trim(Result)
      End Function



      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               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
            ' .. otherwise it's between 20 and 99.
            Select Case Val(Left(MyTens, 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

            ' Convert ones place digit.
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If

         ConvertTens = Result
     End Function



      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function


这样子抄下来还是不会看，，遭

goatstudio

不需要会看, 当然能看一下了解最好...
但如果不想了解, 也无所谓, 因为这 function 已经写好, 只要运用就可以.
问题在于, 你要把这 function 用在那里?

这 code 一定要放在 Access 的 Module 里.

程家伟

原来是这样，

其实这个function是要用在我的invoice report里。。。是不是要先create一个的textbox。然后命名为MyNumber呢？还是把我的原本[P-Total]的数目与在access里module的MyNumber换名？

最后问题是如何的把output拿出来呢？还是create一个subfunction 写  Me![MyNumber]=Me![P-Total]？

如果方法不对，请教教我几下。。。拜托了

[ 本帖最后由 程家伟 于 1-9-2006 08:43 AM 编辑 ]

程家伟

Private Sub cmdConvert_Click()
    txtResult = NumToText(Val(txtNumber))
    txtNumber.SelStart = 0                            <----这一段出现问题了
    txtNumber.SelLength = Len(txtNumber)
    txtNumber.SetFocus
End Sub
  
Private Function NumToText(dblVal 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
    Static bInit As Boolean
    Dim i As Integer, bAllZeros As Boolean, bShowThousands As Boolean
    Dim strVal As String, strBuff As String, strTemp As String
    Dim nCol As Integer, nChar As Integer

    'Only handles positive values
    Debug.Assert dblVal >= 0

    If bInit = False Then
        'Initialize array
        bInit = True
        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) = "ninety"
        Thousands(0) = ""
        Thousands(1) = "thousand"   'US numbering
        Thousands(2) = "million"
        Thousands(3) = "billion"
        Thousands(4) = "trillion"
    End If
    'Trap errors
    On Error GoTo NumToTextError
    'Get fractional part
    strBuff = "and " & Format((dblVal - Int(dblVal)) * 100, "00" & "/100"
    'Convert rest to string and process each digit
    strVal = CStr(Int(dblVal))
    'Non-zero digit not yet encountered
    bAllZeros = True
    'Iterate through string
    For i = Len(strVal) To 1 Step -1
        'Get value of this digit
        nChar = Val(Mid$(strVal, i, 1))
        'Get column position
        nCol = (Len(strVal) - i) + 1
        'Action depends on 1's, 10's or 100's column
        Select Case (nCol Mod 3)
            Case 1  '1's position
                bShowThousands = True
                If i = 1 Then
                    'First digit in number (last in loop)
                    strTemp = Ones(nChar) & " "
                ElseIf Mid$(strVal, i - 1, 1) = "1" Then
                    'This digit is part of "teen" number
                    strTemp = Teens(nChar) & " "
                    i = i - 1   'Skip tens position
                ElseIf nChar > 0 Then
                    'Any non-zero digit
                    strTemp = Ones(nChar) & " "
                Else
                    'This digit is zero. If digit in tens and hundreds column
                    'are also zero, don't show "thousands"
                    bShowThousands = False
                    'Test for non-zero digit in this grouping
                    If Mid$(strVal, i - 1, 1) <> "0" Then
                        bShowThousands = True
                    ElseIf i > 2 Then
                        If Mid$(strVal, i - 2, 1) <> "0" Then
                            bShowThousands = True
                        End If
                    End If
                    strTemp = ""
                End If
                'Show "thousands" if non-zero in grouping
                If bShowThousands Then
                    If nCol > 1 Then
                        strTemp = strTemp & Thousands(nCol \ 3)
                        If bAllZeros Then
                            strTemp = strTemp & " "
                        Else
                            strTemp = strTemp & ", "
                        End If
                    End If
                    'Indicate non-zero digit encountered
                    bAllZeros = False
                End If
                strBuff = strTemp & strBuff
            Case 2  '10's position
                If nChar > 0 Then
                    If Mid$(strVal, i + 1, 1) <> "0" Then
                        strBuff = Tens(nChar) & "-" & strBuff
                    Else
                        strBuff = Tens(nChar) & " " & strBuff
                    End If
                End If
            Case 0  '100's position
                If nChar > 0 Then
                    strBuff = Ones(nChar) & " hundred " & strBuff
                End If
        End Select
    Next i
    'Convert first letter to upper case
    strBuff = UCase$(Left$(strBuff, 1)) & Mid$(strBuff, 2)
EndNumToText:
    'Return result
    NumToText = strBuff
    Exit Function
NumToTextError:
    strBuff = "#Error#"
    Resume EndNumToText
End Function

有谁可以帮个忙。。。问题是讲着 “ You Cannot reffence a property or menthod for a control unless the control has the focus ”

程家伟

这是我的最新coding....和之前的一样。。可是问题就是没有小数点的？比如讲7.50cent....这个coding没有完全得出来呢，
out put 的答案是7.00 然后convert text的答案是seven Dollars And No Cents ...十万个为什么？

Option Explicit
Private Sub cmdConvert_Click()
    txtResult = ConvertCurrencyToEnglish(Val(txtNumber))
  End Sub

Function ConvertCurrencyToEnglish(ByVal MyNumber)
         Dim Temp
         Dim Dollars, Cents
         Dim DecimalPlace, Count

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, "."

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If

         Count = 1
         Do While MyNumber <> ""
            ' Convert last 3 digits of MyNumber to English dollars.
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
            If Len(MyNumber) > 3 Then
               ' Remove last 3 converted digits from MyNumber.
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop

         ' Clean up dollars.
         Select Case Dollars
            Case ""
               Dollars = "No Dollars"
            Case "One"
               Dollars = "One Dollar"
            Case Else
               Dollars = Dollars & " Dollars"
         End Select

         ' Clean up cents.
         Select Case Cents
            Case ""
               Cents = " And No Cents"
            Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select

         ConvertCurrencyToEnglish = Dollars & Cents
      End Function

     Private Function ConvertHundreds(ByVal MyNumber)
         Dim Result As String

         ' Exit if there is nothing to convert.
         If Val(MyNumber) = 0 Then Exit Function

         ' Append leading zeros to number.
         MyNumber = Right("000" & MyNumber, 3)

         ' Do we have a hundreds place digit to convert?
         If Left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
         End If

         ' Do we have a tens place digit to convert?
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If

         ConvertHundreds = Trim(Result)
      End Function

      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               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
            ' .. otherwise it's between 20 and 99.
            Select Case Val(Left(MyTens, 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

            ' Convert ones place digit.
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If

         ConvertTens = Result
     End Function

      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function

[ 本帖最后由 程家伟 于 1-9-2006 11:00 AM 编辑 ]

程家伟

GOATSTUDIO大大，，我这个的CONVERTER DIGIT 去 TEXT 已经成功地做到了。。。DATA TYPE 要换去 DOUBLE 就可以了。。。 谢谢你找给我的CODING。。。感激万分了。。。

请你喝的

[ 本帖最后由 程家伟 于 1-9-2006 11:33 AM 编辑 ]

程家伟

刚刚做完的。。。
我是用四个textbox 和一个button来做测验。。
两个是拿来加数，
一个textbox(textbox的name 我放的是MyNumber1)是答案，
然后一个textbox是名叫txtResult...
然后在我的button的event里我选上了on click 的 procedure来执行我的coding。。。



Option Compare Database
Option Explicit

Function ConvertCurrencyToEnglish(ByVal MyNumber1)
         Dim Temp
         Dim Ringgit, Cents
         Dim DecimalPlace, Count

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, "."

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If

         Count = 1
         Do While MyNumber <> ""
            ' Convert last 3 digits of MyNumber to English Ringgit.
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then Ringgit = Temp & Place(Count) & Ringgit
            If Len(MyNumber) > 3 Then
               ' Remove last 3 converted digits from MyNumber.
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop

         ' Clean up Ringgit.
         Select Case Ringgit
            Case ""
               Ringgit = ""
            Case "One"
               Ringgit = " One Ringgit"
            Case Else
               Ringgit = Ringgit & " Ringgit"
         End Select

         ' Clean up cents.
         Select Case Cents
            Case ""
               Cents = " Only"
            Case "One"
               Cents = " And One Cent Only"
            Case Else
               Cents = " And Cents " & Cents & " Only"
         End Select

         ConvertCurrencyToEnglish = Ringgit & Cents
      End Function

     Private Function ConvertHundreds(ByVal MyNumber)
         Dim Result As String

         ' Exit if there is nothing to convert.
         If Val(MyNumber) = 0 Then Exit Function

         ' Append leading zeros to number.
         MyNumber = Right("000" & MyNumber, 3)

         ' Do we have a hundreds place digit to convert?
         If Left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
         End If

         ' Do we have a tens place digit to convert?
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If

         ConvertHundreds = Trim(Result)
      End Function

      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               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
            ' .. otherwise it's between 20 and 99.
            Select Case Val(Left(MyTens, 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

            ' Convert ones place digit.
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If

         ConvertTens = Result
     End Function

      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function

Private Sub Command10_Click()

txtResult = ConvertCurrencyToEnglish(Val(txtNumber1))

On Error GoTo Err_Command10_Click 《---这里是我click button 后就跑去我的report了

    Dim stDocName As String

    stDocName = "Table2"
    DoCmd.OpenReport stDocName, acPreview

Exit_Command10_Click:
    Exit Sub

Err_Command10_Click:
    MsgBox Err.Description
    Resume Exit_Command10_Click
   
End Sub

小小的问题就出现了，问题就是我新的result不能立刻的出现在我的report里display..但是我必须要按 access 里的 < 回去一页 或者 >下一页 的符号，才会有新的converted text result出现在我的report里