Ad-in doi so thanh chu USD? (1 người xem)

[CPH]

Toi dang tim Ad-in doi so ra chu thanh USD.
VD: 100.12 USD
KQ: Mot tram do muoi hai cent.
Mong cac ban chi giao.
Thanks

 

[Pansy_flower]

Toi dang tim Ad-in doi so ra chu thanh USD.
VD: 100.12 USD
KQ: Mot tram do muoi hai cent.
Mong cac ban chi giao.
Thanks

Bạn xem các file sau đây nha:

- Add-in Name Manager của anh Maika.

-Add-Ins đọc số thành chữ !

-Add-in chuyển số thành chữ của Anh Lê Hồng Đức.

 

[CPH]

Thanks!
Nhưng làm cách nào để chuyển thành font TCVN3 nhi?

 

[anhphuong]

Bạn vào trang code của hàm và chọn font theo yêu cầu trong cửa sổ viết code , chỉnh sửa lại những từ tiếng Việt theo font đó

 

[anhphuong]

Bạn vào trang viết code, chọn Font chữ theo yêu cầu(Tools/Options/Editor Format) rồi chỉnh sửa những từ tiếng Việt theo font đó là được

 

[CPH]

Các bạn làm ơn sửa giúp cái VBA này.
Khi tôi viết 12 thì nó lại đọc là mười hai đô la cent
Luon tiện các bạn sửa luôn nó thành font TCVN3 giúp tôi với, tôi sửa mà nó cứ chạy lung tung, chuối thật.

Function USVN(Amtu)
If Amtu = 0 Then
Resp = "Khoâng USD"
Else
If Abs(Amtu) > 999999999999.99 Then
Resp = "Soá quaù lôùn"
Else
If Amtu < 0 Then
Resp = "Tröø "
Else
Resp = Space(0)
End If
Tien = Format(Abs(Amtu), "###########0.00")
Tien = Right(Space(12) + Tien, 15)
Doc = Space(0): Dem = Doc
Doc = Doc + "traêm möôi tyû "
Doc = Doc + "traêm möôi trieäu"
Doc = Doc + "traêm möôi ngaøn "
Doc = Doc + "traêm möôi ñoâla "
Doc = Doc + "traêm möôi cent "
Dem = Dem + "moät hai ba boán naêm "
Dem = Dem + "saùu baûy taùm chín "
For i = 1 To 5
NHOM = Mid(Tien, i * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If i = 4 Then
Chu = "Ñoâ la "
Else
Chu = Space(0)
End If
Case ".00"
Chu = "chaün"
Case Else
SO1 = Left(NHOM, 1)
So2 = Mid(NHOM, 2, 1)
So3 = Right(NHOM, 1)
Chu = Space(0)
For J = 1 To 3
Dich = Space(0)
S = Val(Mid(NHOM, J, 1))
If S > 0 Then
Dich = Trim(Mid(Dem, S * 5 - 4, 5)) + " " + Trim(Mid(Doc, (i - 1) * 18 + J * 6 - 5, 6)) + " "
End If
Select Case J
Case 2 And S = 1
Dich = "möôøi "
Case 3 And S = 0 And NHOM <> Space(2) + "0"
Dich = Trim(Mid(Doc, (i - 1) * 18 + J * 6 - 5, 6)) + Space(1)
Case 3 And S = 5 And So2 <> Space(1) And So2 <> "0"
Dich = "l" + Mid(Dich, 2)
Case 2 And S = 0 And So3 <> "0"
If (SO1 >= "1" And SO1 <= "9") Or (SO1 = "0" And i = 4) Then
Dich = "leû "
End If
End Select
Chu = Chu + Dich
Next J
End Select
Vitri = InStr(1, Chu, "möôi moät", 1)
If Vitri > 0 Then Mid(Chu, Vitri, 9) = "möôi moát"
Resp = Resp + Chu
End If
Next i
End If
End If
USVN = UCase(Left(Resp, 1)) + Mid(Resp, 2)
End Function

 

[ThuNghi]

Tôi lấy cái này trong name manger (Maika) và sửa cho bạn
Function USDU(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" & 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) & " .Vntime - Copyright by MaiKa of AQN (0953-357-988)"
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$(272), "t" & ChrW$(272), "tri" & ChrW$(7879) & "u", "ng" & ChrW$(224) & "n", "®« la", "Cent")
Dem = Array("None", "m" & ChrW$(7897) & "t", "hai", "ba", "b" & ChrW$(7889) & "n", "n" & ChrW$(259) & "m", "s" & ChrW$(225) & "u", "b" & ChrW$(7849) & "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
USDU = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

 

[CPH]

Bạn xem lại giúp với!
Khi viết 12,1 thì nó đọc đúng là "Mười hai đô la mười cent"
Nhưng khi viết 12 thì nó lại đọc là "Mười hai đôla cent" chứ ko phải "Mười hai đô la"

Thanks

 

[ThuNghi]

12,1 thì nó đọc đúng là "Mười hai đô la mười cent" thì đúng rồi
còn bạn có chọn là USDU(stien) không, tôi test lại không bị. Để tôi tìm lại trên 4r có file TCVN rồi chỉ cho, trước mắt dùng cái này.

 

[CPH]

12,1 thì nó đọc đúng là "Mười hai đô la mười cent" thì đúng rồi
còn bạn có chọn là USDU(stien) không, tôi test lại không bị. Để tôi tìm lại trên 4r có file TCVN rồi chỉ cho, trước mắt dùng cái này.

Vì sao tôi làm ko đc nhỉ? nó vẫn đọc là 12 đô la cent.
Có ai giup tôi sửa cái VBA này không?
Tôi muốn khi viết 12,1 thì nó đọc thành "Mười hai đô la Mỹ và mười cents", khi viết 12 thì nó đọc thành "Mười hai đô la Mỹ"
Tôi đang cần gấp!
Mong được giúp đỡ, Xin cảm ơn.

 

[ThuNghi]

Function USDTCVN(baonhieu)
' Tien Viet tieng Viet Font TCVN - MaiKa of AQN (0953-357-988)"

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è qu¸ lín - Hµm ®æi sè ra ch÷ ViÖt Nam; font ch÷ .Vntime "

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", "®« la Mü", "cent")
Dem = Array("None", "mét", "hai", "ba", "bèn", "n¨m", "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 = "®« la Mü" & Space(1)
Else
Chu = Space(0)
End If
Case ".00"
Chu = ""
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­ê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Î" & 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
USDTCVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
End Function

 

[CPH]

Cảm ơn bạn Thu Nghị rất nhiều, nhưng bạn có thể cho thêm từ và khi đọc thêm từ Cent đc ko?
Ví dụ: 12,1 thì là Mười hai đô la mỹ và mười cent.
Vì Công ty tôi bắt buộc phải viết dúng chính xác từng từ một.
Rất mong bạn Thu Nghị giúp cho chót.
Cảm ơn bạn rất nhiều.

 

[nvson]

Với đoạn code trên bạn thêm vài dòng lệnh là được thôi (đoạn chữ màu đỏ)

Function USDTCVN(baonhieu)
' Tien Viet tieng Viet Font TCVN - MaiKa of AQN (0953-357-988)"
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è qu¸ lín - Hµm ®æi sè ra ch÷ ViÖt Nam; font ch÷ .Vntime "
    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&shy;¬i", "g× ®ã")
        Doc = Array("None", "ngµn tû", "tû", "triÖu", "ngµn", "®« la Mü", "cent")
        Dem = Array("None", "mét", "hai", "ba", "bèn", "n¨m", "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 = "®« la Mü" & Space(1)
                    Else
                        Chu = Space(0)
                    End If
                Case ".00"
                    Chu = ""
                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&shy;ê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Î" & Space(1)
                            End If
                        End Select
                        
                        Chu = Chu & Dich
                    Next J
                End Select
                
                ViTri = InStr(1, Chu, "m&shy;¬i mét", 1)
                If ViTri > 0 Then Mid(Chu, ViTri, 9) = "m&shy;¬i mèt"
                KetQua = KetQua & Chu
            End If
        Next I
    End If
End If
'Viet chu hoa dau cau
USDTCVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
[COLOR=red][B]If InStr(1, UCase(Left(KetQua, 1)) & Mid(KetQua, 2), "cent", 1) > 0 Then
    USDTCVN = Replace(USDTCVN, "®« la Mü", "®« la Mü vµ")
End If[/B][/COLOR]
End Function

 

[trithanh]

Chào Các Bác ,
Sao Hàm Này nó không chạy trên sheet cũ của Em, sheet mới toanh thì nó chạy được, em dung đổi số ra chữ trên sheet cũ đang có dữ liệu thì không được,

 

[CPH]

Chào Các Bác ,
Sao Hàm Này nó không chạy trên sheet cũ của Em, sheet mới toanh thì nó chạy được, em dung đổi số ra chữ trên sheet cũ đang có dữ liệu thì không được,

Bạn copy đoạn code trên rồi save as thành add-in, sau đó vào tools\add-ins\browse đến chỗ để add-in vừa save là ok.

 

[trithanh]

Ban CPH oi, dùng chương trình nào để save as thành add-in vay? và cho mình hỏi luồn là dùng chương trình nào để mở file add-in da lam va mình muốn sửa thêm vào,
cám ơn bạn nhiều.

 

[Peter_pan]

Ban CPH oi, dùng chương trình nào để save as thành add-in vay? và cho mình hỏi luồn là dùng chương trình nào để mở file add-in da lam va mình muốn sửa thêm vào,
cám ơn bạn nhiều.

Bạn xem bài Minh họa cách tạo, nạp và sử dụng Add-Ins trong MS Excel nhé!.