Hướng dẫn tạo Macro chuyển số thành chữ trong Open Office 3.1 (Tiếng Việt Unicode)

Liên hệ QC

cadafi

Hành động từ trái tim
Thành viên BQT
Administrator
Tham gia
27/5/07
Bài viết
4,297
Được thích
11,386
Donate (Paypal)
Donate
Giới tính
Nam
Nghề nghiệp
Business Man
Topic này sẽ hướng dẫn các bạn tạo một hàm đọc số ra chữ bằng tiếng Việt Unicode sử dụng trong Open Office phiên bản từ 3.x

Các thao tác để vào màn hình soạn thảo Open basics tương tự như hướng dẫn tại topic này
Trên cơ sở Code viết Hàm đọc số ra chữ Unicode viết trên VBA, sự khác biệt giữa Open Basic và Visual Basic nằm ở chỗ hàm ChrW$() của VBA và Chr$() của Open Basic. Ta chỉ cần thay ChrW$() thành Chr$() là xong.

Đây là đoạn code dành cho Open Basic
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
Các bạn xem file đính kèm nhé.
Trong trường hợp khi mở file đính kèm lên mà thấy xuất hiện lỗi như sau:

attachment.php


Lúc này đừng lo lắng. Click OK và sau đó Vào Tool/Option và thao tác như hình bên dưới nhé!

attachment.php


attachment.php



attachment.php


Sau đó đóng file này lại và sau đó mở lại, lúc này nhớ chọn Enable Macro nhé!

Chúc các bạn một ngày làm việc vui vẻ và thành công!
 

File đính kèm

  • OpenOfficeFunction.zip
    14.6 KB · Đọc: 905
  • Main.jpg
    Main.jpg
    32.1 KB · Đọc: 990
  • 05-06-2009 09-14-30.jpg
    05-06-2009 09-14-30.jpg
    79.5 KB · Đọc: 959
  • 05-06-2009 09-15-07.jpg
    05-06-2009 09-15-07.jpg
    124.2 KB · Đọc: 940
  • 05-06-2009 09-15-43.jpg
    05-06-2009 09-15-43.jpg
    81.2 KB · Đọc: 943
Chỉnh sửa lần cuối bởi điều hành viên:
Chào bạn Ca_dafi!
Mình có đoạn code này chạy trong excel thì rất tôt, nhưng khi mình chuyển qua OpenOffice thì lại không chạy được. Bạn giúp mình với, Cám ơn bạn rất nhiều. mail của mình: vdtuong_agu@yahoo.com

PHP:
Public dvt As String
Public chu As String
Public bangchu(0 To 9, 0 To 2) As String
Public banghang(0 To 5) As String
Public bangvaloi(1 To 9, 1 To 2) As String
Public i As Integer
Public sole As Single
Public l As Integer
Public so As Integer
Public so1 As Integer
Public so2 As Integer
Public so3 As Integer
Public so4 As Integer
Public nhom As Integer
Public du As Integer

Function VND(number, unit, dec) As String
bangchu(0, 0) = "Kh" & ChrW(244) & "ng " & "tr" & ChrW(259) & "m "
bangchu(1, 0) = "M" & ChrW(7897) & "t " & "tr" & ChrW(259) & "m "
bangchu(2, 0) = "Hai " & "tr" & ChrW(259) & "m "
bangchu(3, 0) = "Ba " & "tr" & ChrW(259) & "m "
bangchu(4, 0) = "B" & ChrW(7889) & "n " & "tr" & ChrW(259) & "m "
bangchu(5, 0) = "N" & ChrW(259) & "m " & "tr" & ChrW(259) & "m "
bangchu(6, 0) = "S" & ChrW(225) & "u " & "tr" & ChrW(259) & "m "
bangchu(7, 0) = "B" & ChrW(7843) & "y " & "tr" & ChrW(259) & "m "
bangchu(8, 0) = "T" & ChrW(225) & "m " & "tr" & ChrW(259) & "m "
bangchu(9, 0) = "Ch" & ChrW(237) & "n " & "tr" & ChrW(259) & "m "
'bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Kh" & ChrW(244) & "ng ", " ")
bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Kh" & ChrW(244) & "ng ", "")
bangchu(1, 1) = "M" & ChrW(7897) & "t "
bangchu(2, 1) = "Hai "
bangchu(3, 1) = "Ba "
bangchu(4, 1) = "B" & ChrW(7889) & "n "
bangchu(5, 1) = "N" & ChrW(259) & "m "
bangchu(6, 1) = "S" & ChrW(225) & "u "
bangchu(7, 1) = "B" & ChrW(7843) & "y "
bangchu(8, 1) = "T" & ChrW(225) & "m "
bangchu(9, 1) = "Ch" & ChrW(237) & "n "
bangchu(0, 2) = "l" & ChrW(7866) & " "
'bangchu(0, 2) = ChrW(7849) & " " & ChrW(7859) & " " & ChrW(7869) & " " & ChrW(7879) & " "
bangchu(1, 2) = "M" & ChrW(432) & ChrW(7901) & "i "
bangchu(2, 2) = "Hai " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(3, 2) = "Ba " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(4, 2) = "B" & ChrW(7889) & "n " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(5, 2) = "N" & ChrW(259) & "m " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(6, 2) = "S" & ChrW(225) & "u " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(7, 2) = "B" & ChrW(7843) & "y " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(8, 2) = "T" & ChrW(225) & "m " & "m" & ChrW(432) & ChrW(417) & "i "
bangchu(9, 2) = "Ch" & ChrW(237) & "n " & "m" & ChrW(432) & ChrW(417) & "i "
banghang(0) = ""
banghang(1) = ""
banghang(2) = "ngh" & ChrW(236) & "n "
banghang(3) = "tri" & ChrW(7879) & "u "
banghang(4) = "t" & ChrW(7927) & " "
banghang(5) = "ngh" & ChrW(236) & "n " & "t" & ChrW(7927) & " "

bangvaloi(1, 1) = "m" & ChrW(432) & ChrW(417) & "i " & "m" & ChrW(7897) & "t "
bangvaloi(2, 1) = "i n" & ChrW(259) & "m "
bangvaloi(1, 2) = "m" & ChrW(432) & ChrW(417) & "i " & "m" & ChrW(7889) & "t "
bangvaloi(2, 2) = "i l" & ChrW(259) & "m "
tam = Abs(number)
tam = Int(tam)
l = Len(tam)

For i = 1 To l
so = Mid(tam, i, 1)
so1 = IIf(i > l - 1, 0, Mid(tam, i + 1, 1))
so2 = IIf(i > l - 2, 0, Mid(tam, i + 2, 1))
If i < 2 Then
so3 = 0
Else
so3 = Mid(tam, i - 1, 1)
End If
If i < 3 Then
so4 = 0
Else
so4 = Mid(tam, i - 2, 1)
End If
nhom = Int(l - i + 1) / 3 + 1
du = (l - i + 1) Mod 3
If ((du = 0) And (so = 0) And (so1 = 0) And (so2 = 0)) Or ((du = 2) And (so = 0) And (so1 = 0)) = True Then
chu = " "
Else
chu = bangchu(so, du)
End If
If (du = 1) And ((so <> 0) Or (so3 <> 0) Or (so4 <> 0)) Then
chu = chu & banghang(nhom)
End If
If chu <> " " Then
If i = 1 Then
VND = chu
Else
VND = VND & LCase(chu)
End If
End If
Next i

VND = Replace(VND, bangvaloi(1, 1), bangvaloi(1, 2))
VND = Replace(VND, bangvaloi(2, 1), bangvaloi(2, 2))
sole = Abs(number) - Int(Abs(number))

If sole > 0 Then
Select Case unit
Case 0
dvt = ""
Case 1
dvt = ChrW(273) & ChrW(7891) & "ng "
Case 2
dvt = ChrW(273) & ChrW(244) & "la m" & ChrW(7929) & " "
Case 3
dvt = "Euro"
Case 4
dvt = "l" & ChrW(432) & ChrW(7907) & "ng v" & ChrW(224) & "ng "
Case Else
dvt = unit
End Select
Else
Select Case unit
Case 0
dvt = IIf(dec = 2, IIf(tam < 2, "cent", "cents"), IIf(dec = 1, "xu", IIf(dec = 4, "ch" & ChrW(7880), IIf(dec = 0, "", dec))))
'dvt = IIf(dec = 1, IIf(tam < 2, "cent", "cents"), IIf(dec = 0, "", dec))
Case 1
dvt = ChrW(273) & ChrW(7891) & "ng " & "ch" & ChrW(7861) & "n "
Case 2
dvt = "d" & ChrW(244) & "la m" & ChrW(7929) & " ch" & ChrW(7861) & "n "
Case 3
dvt = "Euro " & "ch" & ChrW(7861) & "n "
Case 4
dvt = "l" & ChrW(432) & ChrW(7907) & "ng v" & ChrW(224) & "ng " & "ch" & ChrW(7861) & "n "
Case Else
dvt = unit & "ch" & ChrW(7861) & "n "
End Select
End If
Select Case number
Case 0
VND = ""
Case Is > 0
VND = Trim(VND & dvt)
Case Else
VND = "AÂm " & LCase(VND)
VND = Trim(VND & dvt)
End Select
If sole > 0 Then
'VND = Trim(VND) & IIf(dec = 0, " phaåy ", " v" & ChrW(224) & " ")
VND = Trim(VND) & IIf(dec = 0, " ph" & ChrW(7849) & "y ", " ")
VND = VND & IIf(Round(sole * 100, 0) < 10 And dec = 0, "Kh" & ChrW(244) & "ng ", "")
VND = VND & LCase(VND(Round(sole * 100, 0), 0, dec))
Else
VND = VND & "."
'Exceptions:
VND = IIf(tam > 1, Replace(VND, "penny", "pence"), VND)
VND = IIf(tam > 1, Replace(VND, "foot", "feet"), VND)

End If

'Exceptions:
VND = IIf(tam > 1, Replace(VND, "penny", "pence"), VND)
VND = IIf(tam > 1, Replace(VND, "foot", "feet"), VND)

End Function

Function USD(number, unit, dec) As String
bangchu(0, 0) = "Zero hundred "
bangchu(1, 0) = "One hundred "
bangchu(2, 0) = "Two hundred "
bangchu(3, 0) = "Three hundred "
bangchu(4, 0) = "Four hundred "
bangchu(5, 0) = "Five hundred "
bangchu(6, 0) = "Six hundred "
bangchu(7, 0) = "Seven hundred "
bangchu(8, 0) = "Eight hundred "
bangchu(9, 0) = "Nine hundred "
'bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Zero ", " ")
bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Zero ", "")
bangchu(1, 1) = "One "
bangchu(2, 1) = "Two "
bangchu(3, 1) = "Three "
bangchu(4, 1) = "Four "
bangchu(5, 1) = "Five "
bangchu(6, 1) = "Six "
bangchu(7, 1) = "Seven "
bangchu(8, 1) = "Eight "
bangchu(9, 1) = "Nine "
bangchu(0, 2) = "and "
bangchu(1, 2) = "Ten "
bangchu(2, 2) = "Twenty "
bangchu(3, 2) = "Thirty "
bangchu(4, 2) = "Fourty "
bangchu(5, 2) = "Fifty "
bangchu(6, 2) = "Sixty "
bangchu(7, 2) = "Seventy "
bangchu(8, 2) = "Eighty "
bangchu(9, 2) = "Ninety "
banghang(0) = ""
banghang(1) = ""
banghang(2) = "thousand "
banghang(3) = "million "
banghang(4) = "billion "
banghang(5) = "thousand billion "

bangvaloi(1, 1) = "Ten one"
bangvaloi(1, 2) = "Eleven"
bangvaloi(2, 1) = "Ten two"
bangvaloi(2, 2) = "Twelve"
bangvaloi(3, 1) = "Ten three"
bangvaloi(3, 2) = "Thirteen"
bangvaloi(4, 1) = "Ten four"
bangvaloi(4, 2) = "Fourteen"
bangvaloi(5, 1) = "Ten five"
bangvaloi(5, 2) = "Fifteen"
bangvaloi(6, 1) = "Ten six"
bangvaloi(6, 2) = "Sixteen"
bangvaloi(7, 1) = "Ten seven"
bangvaloi(7, 2) = "Seventeen"
bangvaloi(8, 1) = "Ten eight"
bangvaloi(8, 2) = "Eighteen"
bangvaloi(9, 1) = "Ten nine"
bangvaloi(9, 2) = "Nineteen"

tam = Abs(number)
tam = Int(tam)
l = Len(tam)

For i = 1 To l
so = Mid(tam, i, 1)
so1 = IIf(i > l - 1, 0, Mid(tam, i + 1, 1))
so2 = IIf(i > l - 2, 0, Mid(tam, i + 2, 1))
If i < 2 Then
so3 = 0
Else
so3 = Mid(tam, i - 1, 1)
End If
If i < 3 Then
so4 = 0
Else
so4 = Mid(tam, i - 2, 1)
End If
nhom = Int(l - i + 1) / 3 + 1
du = (l - i + 1) Mod 3
If ((du = 0) And (so = 0) And (so1 = 0) And (so2 = 0)) Or ((du = 2) And (so = 0) And (so1 = 0)) = True Then
chu = " "
Else
chu = bangchu(so, du)
End If
If (du = 1) And ((so <> 0) Or (so3 <> 0) Or (so4 <> 0)) Then
chu = chu & banghang(nhom)
End If
If chu <> " " Then
If i = 1 Then
USD = chu
Else
USD = USD & LCase(chu)
End If
End If
Next i

For x = 1 To 9
USD = Replace(USD, bangvaloi(x, 1), bangvaloi(x, 2))
USD = Replace(USD, LCase(bangvaloi(x, 1)), LCase(bangvaloi(x, 2)))
Next x



sole = Abs(number) - Int(Abs(number))

If sole > 0 Then
Select Case unit
Case 0
dvt = ""
Case 1
dvt = IIf(tam < 2, "VN dong", "VN dongs")
Case 2
dvt = IIf(tam < 2, "US dollar", "US dollars")
Case 3
dvt = IIf(tam < 2, "Euro", "Euros")
Case 4
dvt = IIf(tam < 2, "VN luong", "VN luongs")
Case Else
dvt = IIf(tam < 2, unit, unit & "s")
End Select
Else
Select Case unit
Case 0
dvt = IIf(dec = 2, IIf(tam < 2, "cent", "cents"), IIf(dec = 1, "VN xu", IIf(dec = 4, "VN chi", IIf(dec = 0, "", dec))))
'dvt = IIf(dec = 1, IIf(tam < 2, "cent", "cents"), IIf(dec = 0, "", IIf(tam < 2, dec, dec & "s")))
Case 1
dvt = IIf(tam < 2, "VN dong only", "VN dongs only")
Case 2
dvt = IIf(tam < 2, "US dollar only", "US dollars only")
Case 3
dvt = IIf(tam < 2, "Euro only", "Euros only")
Case 4
dvt = IIf(tam < 2, "VN luong only", "VN luongs only")
Case Else

dvt = IIf(tam < 2, unit, unit & "s") & " only"
End Select
End If
Select Case number
Case 0
USD = " "
Case Is > 0
USD = Trim(USD & dvt)
Case Else
USD = "Minus " & LCase(USD)
USD = Trim(USD & dvt)
End Select
If sole > 0 Then
USD = Trim(USD) & IIf(dec = 0, " point ", " and ")
USD = USD & IIf(Round(sole * 100, 0) < 10 And dec = 0, "zero ", "")
USD = USD & LCase(USD(Round(sole * 100, 0), 0, dec))

Else
USD = USD & "."
End If

'Exceptions:
USD = Replace(USD, "pennys", "pence")
USD = Replace(USD, "mouses", "mice")
USD = Replace(USD, "foots", "feet")
End Function
 
Góp thêm hàm chuyển số thành chữ

Chào các bạn !
Trong Excel, tôi viết hàm chuyển số ra chữ theo sách của Ông Văn Thông để sử dụng. Khi nghiên cứu Calc của Open Office tôi lang thang trên mạng và gặp được bài hướng dẫn chuyển số ra chữ, qua tìm hiểu tôi thấy giữa Excel và Calc có cấu trúc của hàm cơ bản là giống nhau, chỉ trừ dòng đầu tiên là khác một chút xíu nhu sau:
Dòng đầu của Excel: Public Function_tên hàm
Dòng đầu của Calc: Function_tên hàm
Dưới đây là hàm đổi số ra chữ mà tôi sử dụng trong Excel, nay đem sang sử dụng trong Calc và thấy kết quả rất tốt. Cùng với hàm đổi số ra chữ, tôi đưa lên đây hàm tính diện tích hình tam giác theo số đo 3 cạnh của tam giác và hàm tìm tên năm âm lịch theo số năm dương lịch Xin gửi lên để các bạn cùng tham khảo.
Về tên hàm, tôi không dùng VND vì hơi bất tiện khi dùng kiểu gõ VNI (chữ D + ( = Đ) nên tôi đổi lại là DVN
Hàm này sử dụng tốt cho Open Office 3.0.1
Trong Open Office 3.0 còn lỗi hiển thị "hai mươi một", "ba mươi một" v.v... thay vì "hai mươi mốt", "ba mươi mốt" v.v...//**/

Mã:
Function DVN(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 d?ng"
    Else
        If Abs(BaoNhieu) >= 1E+15 Then                '1E+15 t?c 1.000.000.000.000.000 t?c 1 tri?u t?
            KetQua = "S? quá l?n"
        Else
            If BaoNhieu < 0 Then
                KetQua = "Tr?" & Space(1)
            Else
                KetQua = Space(0)
            End If
            SoTien = Format(Abs(BaoNhieu), "##############0.00")    '18 digits with 2 decimal
            SoTien = Right(Space(15) & SoTien, 18)
            Hang = Array("None", "tram", "muoi", "gì dó")
            Doc = Array("None", "ngàn t?", "t?", "tri?u", "ngàn", "d?ng", "xu")
            Dem = Array("None", "m?t", "hai", "ba", "b?n", "nam", "sáu", "b?y", "tá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 = "d?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)
                            End If
                            Select Case J
                            Case 2 And S = 1
                                Dich = "mu?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)    'ký t? en l?
                            Case 2 And S = 0 And S3 <> "0"
                                If (S1 >= "1" And S1 <= "9") Or (S1 = "0" And I = 4) Then
                                    Dich = "l?" & Space(1)
                                End If
                            End Select
                            Chu = Chu & Dich
                        Next J
                    End Select
                    Vitri = InStr(1, Chu, "muoi m?t", 1)
                    If Vitri > 0 Then Mid(Chu, Vitri, 9) = "muoi m?t"
                    KetQua = KetQua & Chu
                End If
            Next I
        End If
    End If
    DVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

Function tamgiac(a, b, c)
    If a > b + c Or b > a + c Or c > a + b Then
        tamgiac = 0
    Else
        p = (a + b + c) / 2
        tamgiac = Sqr(p * (p - a) * (p - b) * (p - c))
    End If
End Function

Function AMLICH(Y)
    Dim Can, Chi
    Dim N, M   As Integer
    Can = Array("Canh", "Tân", "Nhâm", "Quý", "Giáp", "?t", "Bính", "Ðinh", "M?u", "K?")
    Chi = Array("Thân", "D?u", "Tu?t", "H?i", "Tý", "S?u", "D?n", "Mão", "Thìn", "T?", "Ng?", "Mùi")
    N = (Y Mod 10)                                    'Mod la toan tu tinh so du phep chia nguyen
    M = (Y Mod 12)
    AMLICH = Can(N) + Space(1) + Chi(M)
End Function
 
Chỉnh sửa lần cuối bởi điều hành viên:
Bạn chủ topic có thể sửa phần chuyển tiếng Việt chữ "chẵn" ko vì 1.234 thì viết thành "một ngàn hai trăm ba mươi bốn đồng chẵn" là ko chính xác.
Phần USD chuyển thành chữ tiếng Việt dc ko, vd 301 "Ba trăm lẻ một đô la Mỹ"
 
cách gọi VND() thế nào bác ơi? sử dụng thế nào?
Chào bạn Ca_dafi! Mình có đoạn code này chạy trong excel thì rất tôt, nhưng khi mình chuyển qua OpenOffice thì lại không chạy được. Bạn giúp mình với, Cám ơn bạn rất nhiều. mail của mình: vdtuong_agu@yahoo.com
PHP:
 Public dvt As String Public chu As String Public bangchu(0 To 9, 0 To 2) As String Public banghang(0 To 5) As String Public bangvaloi(1 To 9, 1 To 2) As String Public i As Integer Public sole As Single Public l As Integer Public so As Integer Public so1 As Integer Public so2 As Integer Public so3 As Integer Public so4 As Integer Public nhom As Integer Public du As Integer  Function VND(number, unit, dec) As String bangchu(0, 0) = "Kh" & ChrW(244) & "ng " & "tr" & ChrW(259) & "m " bangchu(1, 0) = "M" & ChrW(7897) & "t " & "tr" & ChrW(259) & "m " bangchu(2, 0) = "Hai " & "tr" & ChrW(259) & "m " bangchu(3, 0) = "Ba " & "tr" & ChrW(259) & "m " bangchu(4, 0) = "B" & ChrW(7889) & "n " & "tr" & ChrW(259) & "m " bangchu(5, 0) = "N" & ChrW(259) & "m " & "tr" & ChrW(259) & "m " bangchu(6, 0) = "S" & ChrW(225) & "u " & "tr" & ChrW(259) & "m " bangchu(7, 0) = "B" & ChrW(7843) & "y " & "tr" & ChrW(259) & "m " bangchu(8, 0) = "T" & ChrW(225) & "m " & "tr" & ChrW(259) & "m " bangchu(9, 0) = "Ch" & ChrW(237) & "n " & "tr" & ChrW(259) & "m " 'bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Kh" & ChrW(244) & "ng ", " ") bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Kh" & ChrW(244) & "ng ", "") bangchu(1, 1) = "M" & ChrW(7897) & "t " bangchu(2, 1) = "Hai " bangchu(3, 1) = "Ba " bangchu(4, 1) = "B" & ChrW(7889) & "n " bangchu(5, 1) = "N" & ChrW(259) & "m " bangchu(6, 1) = "S" & ChrW(225) & "u " bangchu(7, 1) = "B" & ChrW(7843) & "y " bangchu(8, 1) = "T" & ChrW(225) & "m " bangchu(9, 1) = "Ch" & ChrW(237) & "n " bangchu(0, 2) = "l" & ChrW(7866) & " " 'bangchu(0, 2) = ChrW(7849) & " " & ChrW(7859) & " " & ChrW(7869) & " " & ChrW(7879) & " " bangchu(1, 2) = "M" & ChrW(432) & ChrW(7901) & "i " bangchu(2, 2) = "Hai " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(3, 2) = "Ba " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(4, 2) = "B" & ChrW(7889) & "n " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(5, 2) = "N" & ChrW(259) & "m " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(6, 2) = "S" & ChrW(225) & "u " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(7, 2) = "B" & ChrW(7843) & "y " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(8, 2) = "T" & ChrW(225) & "m " & "m" & ChrW(432) & ChrW(417) & "i " bangchu(9, 2) = "Ch" & ChrW(237) & "n " & "m" & ChrW(432) & ChrW(417) & "i " banghang(0) = "" banghang(1) = "" banghang(2) = "ngh" & ChrW(236) & "n " banghang(3) = "tri" & ChrW(7879) & "u " banghang(4) = "t" & ChrW(7927) & " " banghang(5) = "ngh" & ChrW(236) & "n " & "t" & ChrW(7927) & " "  bangvaloi(1, 1) = "m" & ChrW(432) & ChrW(417) & "i " & "m" & ChrW(7897) & "t " bangvaloi(2, 1) = "i n" & ChrW(259) & "m " bangvaloi(1, 2) = "m" & ChrW(432) & ChrW(417) & "i " & "m" & ChrW(7889) & "t " bangvaloi(2, 2) = "i l" & ChrW(259) & "m " tam = Abs(number) tam = Int(tam) l = Len(tam)  For i = 1 To l so = Mid(tam, i, 1) so1 = IIf(i > l - 1, 0, Mid(tam, i + 1, 1)) so2 = IIf(i > l - 2, 0, Mid(tam, i + 2, 1)) If i < 2 Then so3 = 0 Else so3 = Mid(tam, i - 1, 1) End If If i < 3 Then so4 = 0 Else so4 = Mid(tam, i - 2, 1) End If nhom = Int(l - i + 1) / 3 + 1 du = (l - i + 1) Mod 3 If ((du = 0) And (so = 0) And (so1 = 0) And (so2 = 0)) Or ((du = 2) And (so = 0) And (so1 = 0)) = True Then chu = " " Else chu = bangchu(so, du) End If If (du = 1) And ((so  0) Or (so3  0) Or (so4  0)) Then chu = chu & banghang(nhom) End If If chu  " " Then If i = 1 Then VND = chu Else VND = VND & LCase(chu) End If End If Next i  VND = Replace(VND, bangvaloi(1, 1), bangvaloi(1, 2)) VND = Replace(VND, bangvaloi(2, 1), bangvaloi(2, 2)) sole = Abs(number) - Int(Abs(number))  If sole > 0 Then Select Case unit Case 0 dvt = "" Case 1 dvt = ChrW(273) & ChrW(7891) & "ng " Case 2 dvt = ChrW(273) & ChrW(244) & "la m" & ChrW(7929) & " " Case 3 dvt = "Euro" Case 4 dvt = "l" & ChrW(432) & ChrW(7907) & "ng v" & ChrW(224) & "ng " Case Else dvt = unit End Select Else Select Case unit Case 0 dvt = IIf(dec = 2, IIf(tam < 2, "cent", "cents"), IIf(dec = 1, "xu", IIf(dec = 4, "ch" & ChrW(7880), IIf(dec = 0, "", dec)))) 'dvt = IIf(dec = 1, IIf(tam < 2, "cent", "cents"), IIf(dec = 0, "", dec)) Case 1 dvt = ChrW(273) & ChrW(7891) & "ng " & "ch" & ChrW(7861) & "n " Case 2 dvt = "d" & ChrW(244) & "la m" & ChrW(7929) & " ch" & ChrW(7861) & "n " Case 3 dvt = "Euro " & "ch" & ChrW(7861) & "n " Case 4 dvt = "l" & ChrW(432) & ChrW(7907) & "ng v" & ChrW(224) & "ng " & "ch" & ChrW(7861) & "n " Case Else dvt = unit & "ch" & ChrW(7861) & "n " End Select End If Select Case number Case 0 VND = "" Case Is > 0 VND = Trim(VND & dvt) Case Else VND = "AÂm " & LCase(VND) VND = Trim(VND & dvt) End Select If sole > 0 Then 'VND = Trim(VND) & IIf(dec = 0, " phaåy ", " v" & ChrW(224) & " ") VND = Trim(VND) & IIf(dec = 0, " ph" & ChrW(7849) & "y ", " ") VND = VND & IIf(Round(sole * 100, 0) < 10 And dec = 0, "Kh" & ChrW(244) & "ng ", "") VND = VND & LCase(VND(Round(sole * 100, 0), 0, dec)) Else VND = VND & "." 'Exceptions: VND = IIf(tam > 1, Replace(VND, "penny", "pence"), VND) VND = IIf(tam > 1, Replace(VND, "foot", "feet"), VND)  End If  'Exceptions: VND = IIf(tam > 1, Replace(VND, "penny", "pence"), VND) VND = IIf(tam > 1, Replace(VND, "foot", "feet"), VND)  End Function  Function USD(number, unit, dec) As String bangchu(0, 0) = "Zero hundred " bangchu(1, 0) = "One hundred " bangchu(2, 0) = "Two hundred " bangchu(3, 0) = "Three hundred " bangchu(4, 0) = "Four hundred " bangchu(5, 0) = "Five hundred " bangchu(6, 0) = "Six hundred " bangchu(7, 0) = "Seven hundred " bangchu(8, 0) = "Eight hundred " bangchu(9, 0) = "Nine hundred " 'bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Zero ", " ") bangchu(0, 1) = IIf(Int(Abs(number)) = 0, "Zero ", "") bangchu(1, 1) = "One " bangchu(2, 1) = "Two " bangchu(3, 1) = "Three " bangchu(4, 1) = "Four " bangchu(5, 1) = "Five " bangchu(6, 1) = "Six " bangchu(7, 1) = "Seven " bangchu(8, 1) = "Eight " bangchu(9, 1) = "Nine " bangchu(0, 2) = "and " bangchu(1, 2) = "Ten " bangchu(2, 2) = "Twenty " bangchu(3, 2) = "Thirty " bangchu(4, 2) = "Fourty " bangchu(5, 2) = "Fifty " bangchu(6, 2) = "Sixty " bangchu(7, 2) = "Seventy " bangchu(8, 2) = "Eighty " bangchu(9, 2) = "Ninety " banghang(0) = "" banghang(1) = "" banghang(2) = "thousand " banghang(3) = "million " banghang(4) = "billion " banghang(5) = "thousand billion "  bangvaloi(1, 1) = "Ten one" bangvaloi(1, 2) = "Eleven" bangvaloi(2, 1) = "Ten two" bangvaloi(2, 2) = "Twelve" bangvaloi(3, 1) = "Ten three" bangvaloi(3, 2) = "Thirteen" bangvaloi(4, 1) = "Ten four" bangvaloi(4, 2) = "Fourteen" bangvaloi(5, 1) = "Ten five" bangvaloi(5, 2) = "Fifteen" bangvaloi(6, 1) = "Ten six" bangvaloi(6, 2) = "Sixteen" bangvaloi(7, 1) = "Ten seven" bangvaloi(7, 2) = "Seventeen" bangvaloi(8, 1) = "Ten eight" bangvaloi(8, 2) = "Eighteen" bangvaloi(9, 1) = "Ten nine" bangvaloi(9, 2) = "Nineteen"  tam = Abs(number) tam = Int(tam) l = Len(tam)  For i = 1 To l so = Mid(tam, i, 1) so1 = IIf(i > l - 1, 0, Mid(tam, i + 1, 1)) so2 = IIf(i > l - 2, 0, Mid(tam, i + 2, 1)) If i < 2 Then so3 = 0 Else so3 = Mid(tam, i - 1, 1) End If If i < 3 Then so4 = 0 Else so4 = Mid(tam, i - 2, 1) End If nhom = Int(l - i + 1) / 3 + 1 du = (l - i + 1) Mod 3 If ((du = 0) And (so = 0) And (so1 = 0) And (so2 = 0)) Or ((du = 2) And (so = 0) And (so1 = 0)) = True Then chu = " " Else chu = bangchu(so, du) End If If (du = 1) And ((so  0) Or (so3  0) Or (so4  0)) Then chu = chu & banghang(nhom) End If If chu  " " Then If i = 1 Then USD = chu Else USD = USD & LCase(chu) End If End If Next i  For x = 1 To 9 USD = Replace(USD, bangvaloi(x, 1), bangvaloi(x, 2)) USD = Replace(USD, LCase(bangvaloi(x, 1)), LCase(bangvaloi(x, 2))) Next x    sole = Abs(number) - Int(Abs(number))  If sole > 0 Then Select Case unit Case 0 dvt = "" Case 1 dvt = IIf(tam < 2, "VN dong", "VN dongs") Case 2 dvt = IIf(tam < 2, "US dollar", "US dollars") Case 3 dvt = IIf(tam < 2, "Euro", "Euros") Case 4 dvt = IIf(tam < 2, "VN luong", "VN luongs") Case Else dvt = IIf(tam < 2, unit, unit & "s") End Select Else Select Case unit Case 0 dvt = IIf(dec = 2, IIf(tam < 2, "cent", "cents"), IIf(dec = 1, "VN xu", IIf(dec = 4, "VN chi", IIf(dec = 0, "", dec)))) 'dvt = IIf(dec = 1, IIf(tam < 2, "cent", "cents"), IIf(dec = 0, "", IIf(tam < 2, dec, dec & "s"))) Case 1 dvt = IIf(tam < 2, "VN dong only", "VN dongs only") Case 2 dvt = IIf(tam < 2, "US dollar only", "US dollars only") Case 3 dvt = IIf(tam < 2, "Euro only", "Euros only") Case 4 dvt = IIf(tam < 2, "VN luong only", "VN luongs only") Case Else  dvt = IIf(tam < 2, unit, unit & "s") & " only" End Select End If Select Case number Case 0 USD = " " Case Is > 0 USD = Trim(USD & dvt) Case Else USD = "Minus " & LCase(USD) USD = Trim(USD & dvt) End Select If sole > 0 Then USD = Trim(USD) & IIf(dec = 0, " point ", " and ") USD = USD & IIf(Round(sole * 100, 0) < 10 And dec = 0, "zero ", "") USD = USD & LCase(USD(Round(sole * 100, 0), 0, dec))  Else USD = USD & "." End If  'Exceptions: USD = Replace(USD, "pennys", "pence") USD = Replace(USD, "mouses", "mice") USD = Replace(USD, "foots", "feet") End Function
 
Các bác cho e hỏi Macro này làm sao để dùng vậy
Số ở cột A , số đổi sang chữ ở cột B . Vậy làm sao để chuyển số sang chữ -> Công thức hay lệnh nào để số đổi sang chữ.
Cảm ơn các bác!
 
Lâu kô tìm hiểu về Open office rồi, chả rõ bây giờ có thêm tính năng mới kô?
 
làm theo hướng dẫn và đã thành công :D cảm ơn các bác đã giúp đỡ nhiệt tình
 
Cám ơn bác đã hướng dẫn, em đã làm thành công nhưng gặp 2 vấn đề 70tr gõ thành Bẩy mươi triệu đồng chẵn và 21tr gõ thành Hai mươi mốttriệu đồng chẵn
em muốn sửa thành Bảy mốt triệu. Bác giúp e với ạ. Cám ơn bác.
 
Cám ơn bác đã hướng dẫn, em đã làm thành công nhưng gặp 2 vấn đề 70tr gõ thành Bẩy mươi triệu đồng chẵn và 21tr gõ thành Hai mươi mốttriệu đồng chẵn
em muốn sửa thành Bảy mốt triệu. Bác giúp e với ạ. Cám ơn bác.
Bạn dùng lại code này nhé:
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" & ChrW(244) & "ng"
    Exit Function
ElseIf IsDate(baonhieu) Then
    ngay = Day(baonhieu)
    Thang = Month(baonhieu)
    Nam = Year(baonhieu)
    VND = "ng" & ChrW(224) & "y " & ngay & " th" & ChrW(225) & "ng " & Thang & " n" & ChrW(462) & "m " & Nam
    Exit Function
ElseIf IsNumeric(baonhieu) = True Then
'---------------------------------------------------------------------------------------------------------------------------------
'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) & " Tahoma - Copyright by VoTuanKiet of AMG (0938 73 73 93)"
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$(7927), "t" & ChrW$(7927), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", ChrW$(273) & ChrW$(7891) & "ng", "") 'ChrW$(273) & ChrW$(7891) & "ng"=dong
        Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7843) & "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
VND = Left(UCase(Left(KetQua, 1)) & Mid(KetQua, 2), Len(UCase(Left(KetQua, 1)) & Mid(KetQua, 2)) - 10)
End Function
 
Web KT

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

Back
Top Bottom