Mình đã sư dụng 2 code sau đây lâu rồi nhưng trên office 2003, hiện nay sử dụng trên 2010 bị lỗi (vẫn đọc được số ra chữ nhưng bị mã không đọc được). do mình làm 2 code trên cùng file bị lỗi rồi.
- Mình muốn cùng một số(Á=1234567890) khi dùng vnd(A1)="........đồng"; khi dùng vnm(A1)="......mét vuông".
1. code1 :
Public Function VND(BaoNhieu)
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim l, 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ố quá 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", "gì đó")
Doc = Array("None", "ngàn tỷ", "tỷ", "triệu", "ngàn", "đồng", "")
Dem = Array("None", "một", "hai", "ba", "bốn", "năm", "sáu", "bảy", "tám", "chín")
For l = 1 To 6
Nhom = Mid(SoTien, l * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If l = 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(l)
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ườ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 l = 4) Then
Dich = "lẻ" & 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 l
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
2. code 2:
Public Function VNM(BaoNhieu)
Dim KetQua, SoTien, Nhom, Chu, Dich, S1, S2, S3 As String
Dim l, J, Vitri As Byte, S As Double
Dim Hang, Doc, Dem
If BaoNhieu = 0 Then
KetQua = "Không mét vuông"
Else
If Abs(BaoNhieu) >= 1E+15 Then
KetQua = "Số quá 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", "gì đó")
Doc = Array("None", "ngàn tỷ", "tỷ", "triệu", "ngàn", "mét vuông", "")
Dem = Array("None", "một", "hai", "ba", "bốn", "năm", "sáu", "bảy", "tám", "chín")
For l = 1 To 6
Nhom = Mid(SoTien, l * 3 - 2, 3)
If Nhom <> Space(3) Then
Select Case Nhom
Case "000"
If l = 5 Then
Chu = "mét vuô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(l)
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ườ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 l = 4) Then
Dich = "lẻ" & 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 l
End If
End If
VNM = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
