Chào mừng đến với Diễn đàn Dân Kế Toán - Kế toán tổng hợp thực tế.
Kết quả 1 đến 8 của 8
  1. #1
    Ngày tham gia
    Aug 2015
    Bài viết
    0

  2. #2
    Ngày tham gia
    Aug 2015
    Bài viết
    2
    Ðề: Đổi số thành chữ




    Trích dẫn Gửi bởi chien-chien
    các pác có nhu cầu liên lạc với em nha, em ko biết đưa lên diễn đàn, pác nào có kinh nghiệm chỉ em đưa đường link lên nha, em cảm ơn.
    Bạn Upload lên Mediafire rồi lấy đường link dán vào diễn đàn là bạn đã chia se vói công đồng rồi.

  3. #3
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ

    :loaloa:
    Bạn nào cần thì ghi lại địa chỉ mail
    Mình sẽ gửi cho các bạn :khonghiu:

  4. #4
    Ngày tham gia
    Nov 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ




    Trích dẫn Gửi bởi hannhu
    :loaloa:
    Bạn nào cần thì ghi lại địa chỉ mail
    Mình sẽ gửi cho các bạn :khonghiu:
    Code trên mạng có nhiều mà, quan trọng là cách sự dụng thôi
    1. Sử dụng Add - In
    2. Là copy code vào cửa sổ VBA

    và một điều quan trọng nữa là phải thiết lập Macro Security ở mức medium trở xuống

  5. #5
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ




    Trích dẫn Gửi bởi chien-chien
    các pác có nhu cầu liên lạc với em nha, em ko biết đưa lên diễn đàn, pác nào có kinh nghiệm chỉ em đưa đường link lên nha, em cảm ơn.
    Sao bạn không đưa le6n diễn đàn luôn khỏi mất công mình và người khác.

    Code đọc số Unicode:



    Mã:
    Function VNUD(baonhieu)
    Dim KetQua, Sotien, Nhom, Chu, Dich, S1, S2, S3 As String
    Dim i, J, ViTri As Byte, S As Double
    Dim Hang, Doc, Dem
    If baonhieu = 0 Then
    KetQua = "Kh" & ChrW$(244) & "ng " & ChrW$(273) & ChrW$(7891) & "ng"
    Else
    If Abs(baonhieu) >= 1E+15 Then
    KetQua = "S" & ChrW$(7889) & " qu" & ChrW$(225) & " l" & ChrW$(7899) & "n - H" & ChrW$(224) & "m " & ChrW$(273) & ChrW$(7893) & "i s" & ChrW$(7889) & " ra ch" & ChrW$(7919) & " Vi" & ChrW$(7879) & "t Nam; font ch" & ChrW$(7919) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
    Else
    If baonhieu < 0 Then
    KetQua = ChrW$(194) & "m" & Space(1)
    Else
    KetQua = Space(0)
    End If
    Sotien = Format(Abs(baonhieu), "##############0.00")
    Sotien = Right(Space(15) & Sotien, 18)
    Hang = Array("None", "tr" & ChrW$(259) & "m", "m" & ChrW$(432) & ChrW$(417) & "i", "g" & ChrW$(236) & " " & ChrW$(273) & "ã")
    Doc = Array("None", "ng" & ChrW$(224) & "n t" & ChrW$(272), "t" & ChrW$(272), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "")
    Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "y", "t" & ChrW$(225) & "m", "ch" & ChrW$(237) & "n")
    For i = 1 To 6
    Nhom = Mid(Sotien, i * 3 - 2, 3)
    If Nhom <> Space(3) Then
    Select Case Nhom
    Case "000"
    If i = 5 Then
    Chu = ChrW$(273) & ChrW$(7891) & "ng" & Space(1)
    Else
    Chu = Space(0)
    End If
    Case ".00"
    Chu = "ch" & ChrW$(7861) & "n"
    Case Else
    S1 = Left(Nhom, 1)
    S2 = Mid(Nhom, 2, 1)
    S3 = Right(Nhom, 1)
    Chu = Space(0)
    Hang(3) = Doc(i)
    For J = 1 To 3
    Dich = Space(0)
    S = Val(Mid(Nhom, J, 1))
    If S > 0 Then
    Dich = Dem(S) & Space(1) & Hang(J) & Space(1)
    End If
    Select Case J
    Case 2 And S = 1
    Dich = "m" & ChrW$(432) & ChrW$(7901) & "i" & Space(1)
    Case 3 And S = 0 And Nhom <> Space(2) & "0"
    Dich = Hang(J) & Space(1)
    Case 3 And S = 5 And S2 <> Space(1) And S2 <> "0"
    Dich = "l" & Mid(Dich, 2)
    Case 2 And S = 0 And S3 <> "0"
    If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And i = 4) Then
    Dich = "l" & ChrW$(7867) & Space(1)
    End If
    End Select
    Chu = Chu & Dich
    Next J
    End Select
    ViTri = InStr(1, Chu, "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7897) & "t", 1)
    If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & ChrW$(432) & ChrW$(417) & "i m" & ChrW$(7889) & "t"
    KetQua = KetQua & Chu
    End If
    Next i
    End If
    End If
    VNUD = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
    End Function
    Code đọc số Tiếng Anh.



    Mã:
    'Main Function
    Function SpellNumber(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 = Dollars & 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
    Các bạn tham khảo thêm file nhé.
    http://www.4shared.com/file/163136763/5792b159/DOC_SO.html

  6. #6
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ




    Trích dẫn Gửi bởi chien-chien
    các pác có nhu cầu liên lạc với em nha, em ko biết đưa lên diễn đàn, pác nào có kinh nghiệm chỉ em đưa đường link lên nha, em cảm ơn.
    Mình up lên cho mọi người cùng dùng nà :hawaii:

    Ơ hơ cái file bín đâu mất tiu rồi :nhaykieumoi: bạn nào cần pm địa chỉ email vào hộp tin cá nhân mình, mình gửi cho hihi mình dùng VnTools, chuyển số thành chữ rất hay, đọc được cả tiếng anh và tiếng việt, chính xác 100% :love05:

  7. #7
    Ngày tham gia
    Nov 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ

    iu bé trang quá gửi cho m nhé.
    di_tim_so_do_2004@yahoo.com

  8. #8
    Ngày tham gia
    Aug 2015
    Bài viết
    0
    Ðề: Đổi số thành chữ




    Trích dẫn Gửi bởi ditimsodo
    iu bé trang quá gửi cho m nhé.
    di_tim_so_do_2004@yahoo.com
    hihi mình tìm được rùi nè, tưởng để trong máy hoá ra trong USB :metwa: Bạn giải nén ra, có hướng dẫn sử dụng ở trong đó lun :dangiuqua:

 

 

Quyền viết bài

  • Bạn Không thể gửi Chủ đề mới
  • Bạn Không thể Gửi trả lời
  • Bạn Không thể Gửi file đính kèm
  • Bạn Không thể Sửa bài viết của mình
  •