PDA

View Full Version : Ad-in doi so thanh chu USD?



CPH
26-04-07, 08:17 PM
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
26-04-07, 10:10 PM
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. (http://www.giaiphapexcel.com/forum/showthread.php?t=1108)

-Add-Ins đọc số thành chữ ! (http://www.giaiphapexcel.com/forum/showthread.php?t=1109)

-Add-in chuyển số thành chữ của Anh Lê Hồng Đức. (http://www.giaiphapexcel.com/forum/showthread.php?t=1120)

CPH
27-04-07, 08:27 AM
Thanks!
Nhưng làm cách nào để chuyển thành font TCVN3 nhi?

anhphuong
27-04-07, 09:13 AM
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
27-04-07, 09:17 AM
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
27-04-07, 09:22 AM
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
27-04-07, 10:10 AM
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
27-04-07, 10:53 AM
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
27-04-07, 12:24 PM
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
02-05-07, 12:37 PM
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
02-05-07, 02:23 PM
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
03-05-07, 08:58 PM
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
05-05-07, 10:39 AM
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­¬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
'Viet chu hoa dau cau
USDTCVN = UCase(Left(KetQua, 1)) & Mid(KetQua, 2)
If InStr(1, UCase(Left(KetQua, 1)) & Mid(KetQua, 2), "cent", 1) > 0 Then
USDTCVN = Replace(USDTCVN, "®« la Mü", "®« la Mü vµ")
End If
End Function

trithanh
16-05-07, 11:47 AM
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
16-05-07, 02:43 PM
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
17-05-07, 09:25 AM
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
17-05-07, 12:39 PM
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 (http://www.giaiphapexcel.com/forum/showthread.php?t=379) nhé!.