Đọc số sang chữ sử dụng font Vietware

[thehungqnu]

Nhờ các Bác xem giúp hộ đoạn code này không đọc được số 0 ở phần nguyên và thập phân. VD: 0.12 chỉ đọc là Mười hai (số cần đọc là không đồng mười hai); số 9.05 chỉ đọc chín đồng năm (số cần đọc là chín đồng không năm)

Public Function VWEX(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äng âäöng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "Säú quaï låïn"
Else
If baonhieu < 0 Then
KetQua = "Á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àm", "mæåi")
Doc = Array("None", "ngaìn tyí", "tyí", "triãûu", "ngaìn", "âäöng", "")
Dem = Array("None", "mäüt", "hai", "ba", "bäún", "nàm", "saïu", "baíy", "taïm", "chê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 = "âäöng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "chàô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)
If S3 = "1" And S2 > "1" And J = 3 Then Dich = "mäút "
End If
Select Case J
Case 2 And S = 1
Dich = "mæåì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 = "leí" & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "mæåi mäút", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "mæåi mäút"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VWEX = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

 

[voda]

Đã chỉnh:

Public Function VWEX(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äng âäöng"
Else
If Abs(baonhieu) >= 1E+15 Then
KetQua = "Säú quaï låïn"
Else
If baonhieu < 0 Then
KetQua = "Á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àm", "mæåi", "khäng")
Doc = Array("None", "ngaìn tyí", "tyí", "triãûu", "ngaìn", "âäöng", "")
Dem = Array("None", "mäüt", "hai", "ba", "bäún", "nàm", "saïu", "baíy", "taïm", "chê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 = "âäöng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "chàô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)
If S3 = "1" And S2 > "1" And J = 3 Then Dich = "mäút "
End If
Select Case J
Case 2 And S = 1
Dich = "mæåìi" & Space(1)
Case 3 And S = 0 And I = 5 And S2 = Space(1)
Dich = "khäng" & " " & Hang(J) & 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 = "leí" & Space(1)
End If
If (S1 = "." And I = 6) Then
Dich = "leí" & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "mæåi mäút", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "mæåi mäút"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VWEX = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function