autumnmoon86
Thành viên mới
- Tham gia
- 30/1/13
- Bài viết
- 4
- Được thích
- 0
Mình tìm được đoạn Macro này của bạn Cadafi trên diễn đàn viết cho Open office, mình đã copy lại và dùng thấy khá tốt. Tuy nhiên vẫn có một lỗi nhỏ, đó là khi đọc số như : 1.005.000 VND máy sẽ đọc thành " Một triệu năm ngàn đồng chẵn" Tuy nhiên mình muốn đọc thành " Một triệu không trăm lẻ năm ngàn đồng chẵn" Tương tự như 1.030.000.000 VND máy đọc là "Một tỷ ba mươi triệu đồng" trong khi phải là " Một tỷ không trăm ba mươi triệu đồng" Bài viết của bạn Cadafi từ năm 2009 nên giờ mình cũng không tiện pm để hỏi lại bạn nữa nên mình copy lên đây nhờ bạn nào giỏi về Macro sửa giúp mình để thêm chức năng đó vào với chứ mình mù tịt khoản này, cảm ơn các bạn nhiều
PHP:
Function VND(baonhieu)
'Tien Viet tieng Viet Font Unicode
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 Trim(baonhieu) = "" Then
VND = ""
Exit Function
ElseIf baonhieu = 0 Then
VND = "kh" & Chr(244) & "ng"
Exit Function
ElseIf IsDate(baonhieu) Then
ngay = Day(baonhieu)
Thang = Month(baonhieu)
Nam = Year(baonhieu)
VND = "ng" & Chr(224) & "y " & ngay & " th" & Chr(225) & "ng " & Thang & " n" & Chr(462) & "m " & Nam
Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'If baonhieu = 0 Then
'KetQua = "Kh" & Chr$(244) & "ng " & Chr$(273) & Chr$(7891) & "ng"
'Else
'---------------------------------------------------------------------------------------------------------------------------------
If Abs(baonhieu) >= 1E+15 Then
KetQua = "S" & Chr$(7889) & " qu" & Chr$(225) & " l" & Chr$(7899) & "n - H" & Chr$(224) & "m " & Chr$(273) & Chr$(7893) & "i s" & Chr$(7889) & " ra ch" & Chr$(7919) & " Vi" & Chr$(7879) & "t Nam; font ch" & Chr$(7919) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
Else
If baonhieu < 0 Then
KetQua = Chr$(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" & Chr$(259) & "m", "m" & Chr$(432) & Chr$(417) & "i", "g" & Chr$(236) & " " & Chr$(273) & "ã")
Doc = Array("None", "ng" & Chr$(224) & "n t" & Chr$(7927), "t" & Chr$(7927), "tri" & Chr$(7879) & "u", "ng" & Chr$(224) & "n", Chr$(273) & Chr$(7891) & "ng", "")
Dem = Array("None", "m" & Chr$(7897) & "t", "hai", "ba", "b" & Chr$(7889) & "n", "n" & Chr$(259) & "m", "s" & Chr$(225) & "u", "b" & Chr$(7849) & "y", "t" & Chr$(225) & "m", "ch" & Chr$(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 = Chr$(273) & Chr$(7891) & "ng" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = "ch" & Chr$(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" & Chr$(432) & Chr$(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" & Chr$(7867) & Space(1)
End If
End Select
Chu = Chu & Dich
Next J
End Select
ViTri = InStr(1, Chu, "m" & Chr$(432) & Chr$(417) & "i m" & Chr$(7897) & "t", 1)
If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m" & Chr$(432) & Chr$(417) & "i m" & Chr$(7889) & "t"
KetQua = KetQua & Chu
End If
Next I
End If
End If
VND = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function
