Chỉnh code đọc mét vuông (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

quynhtlbp

Thành viên chính thức
Tham gia
26/8/10
Bài viết
95
Được thích
29
Nghề nghiệp
Quỹ Tín Dụng Đồng Xoai
Em nhờ các tiền bối chỉnh giúp em code đọc mét vuông do em lấy trên Diễn đàn về sử dụng, trong quá trình sử dụng không đạt yêu cầu đề ra như cac ví dụ dưới đây.
- Trường hợp 1:
- VD: 230,5 m2( trong code đọc là: Hai trăm ba mươi phẩy năm mươi mét vuông).
- Yêu cầu đọc là: Hai trăm ba mươi phẩy năm mét vuông.
- Trường hợp 2: hiện tại vẫn ổn
- VD2: 230,54 m2
thì code đọc: Hai trăm ba mươi phẩy năm mươi bốn mét vuông.
- vậy en xin nhờ các tiền bối giúp em chỉnh code sao cho thỏa mãn hai trường hợp trên.
Em có đính kèm theo file, xin chân thành cảm ơn.



Mã:
On Error GoTo LoiDim str
Dim desStr As String
Dim i
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For i = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(i))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function
Function docmet(ByVal NumCurrency As Currency) As String
Dim CharVND(10) As String, BangChu As String, i As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViM As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
DonViM = ";6D;E9;74;A0;76;75;F4;6E;67" ' met vuong
DonViLe = DonViM
  If NumCurrency = 0 Then
       docmet = UnicodeChar(";4B;68;F4;6E;67;20" & DonViM) 'Khong
       Exit Function
  End If
  If NumCurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
aVND = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
  Exit Function
  End If
CharVND(0) = ";6B;68;F4;6E;67"
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí s?
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
     If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
               BangChu = ";6B;68;F4;6E;67;20" + DonViM + ";20"
               i = 5
     Else
                BangChu = ""
                i = 0
     End If
'-----------------------------------------------------
' B?t d?u d?i
'-----------------------------------------------------
  While i <= 5
      Select Case i
         Case 0
            SoDoi = NganTy
            Ten = ";6E;67;E0;6E;20;74;1EF7;2C" ' ngàn t?
         Case 1
            SoDoi = Ty
            Ten = ";74;1EF7;2C" ' t?
         Case 2
            SoDoi = Trieu
            Ten = ";74;72;69;1EC7;75;2C" ' tri?u
         Case 3
            SoDoi = Ngan
            Ten = ";6E;67;E0;6E;2C" ' ngàn
         Case 4
            SoDoi = Dong
            Ten = "" ' d?ng
            If SoLe > 0 Then Ten = ";70;68;1EA9;79"
         Case 5
             SoDoi = SoLe
             Ten = DonViLe ' xu
       End Select
If SoDoi <> 0 Then
    Tram = Int(SoDoi / 100)
    Muoi = Int((SoDoi - Tram * 100) / 10)
    DonVi = (SoDoi - Tram * 100) - Muoi * 10   '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    If Right(BangChu, 3) = ";20" Then
    BangChu = Left(BangChu, Len(BangChu) - 3)
    End If
    If BangChu <> "" And i < 5 Then
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + _
             Trim(CharVND(Tram)) + ";20;74;72;103;6D;20"
    Else
    BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";20") + _
        IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
     End If
     If BangChu <> "" Then
     If Muoi = 0 And DonVi <> 0 Then
     BangChu = BangChu + ";6C;1EBB;20"
     Else
     If Muoi <> 0 Then
     BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
     End If
     End If
     If Muoi <> 0 And DonVi = 5 Then
     BangChu = BangChu + ";6C;103;6D;20" + Ten
     Else
     If Muoi > 1 And DonVi = 1 Then
     BangChu = BangChu + ";6D;1ED1;74;20" + Ten
     Else
     BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten)
     End If
     End If
     Else
     If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
     BangChu = BangChu + ";6C;1EBB;20"
     Else
     If Muoi <> 0 Then
      BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
    End If
    End If
    If Muoi <> 0 And DonVi = 5 Then
    BangChu = BangChu + ";6C;103;6D;20" + Ten
    Else
    If Muoi > 1 And DonVi = 1 Then
    BangChu = BangChu + ";6D;1ED1;74;20" + Ten
    Else
    BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten)
    End If
    End If
    BangChu = BangChu + IIf(i = 4, "", "")
    End If
    End If
    i = i + 1
   Wend
    If SoLe = 0 Then
          BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", "") + DonViM
    End If
BangChu = UnicodeChar(BangChu)
'Ð?i sang ti?ng Vi?t Unicode
' Ð?i ch? cái d?u tiên thành ch? hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
docmet = BangChu + "."
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
Web KT

Bài viết mới nhất

Back
Top Bottom