Đọc số thành chữ trong textbox

Liên hệ QC

Doãn Quốc Bình

Thành viên chính thức
Tham gia
18/7/18
Bài viết
59
Được thích
3
Giới tính
Nam
Các A/C cho em hỏi chút về đọc số thành chữ trong VBA với ạ:
em có textbox1 để nhập số, phải làm sao để textbox2 sẽ đọc số được nhập vào texbox1 thành chữ vậy ạ?
ví dụ như hình đính kèm ạ.
em dùng module đọc số tiền có code như sau: (Mong A/C giúp em với, em mới tự học VBA thôi ạ. xin chân thành cảm ơn A/C)
Function UnicodeChar(UniCharCode As String) As String
On Error GoTo Loi
Dim str
Dim desStr As String
Dim i
If Mid(UniCharCode, 1, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 2)
End If
If Right(UniCharCode, 1) = ";" Then
UniCharCode = Mid(UniCharCode, 1, Len(UniCharCode) - 1)
End If
str = UniCharCode
str = Split(str, ";")
For i = LBound(str) To UBound(str)
desStr = desStr & ChrW$("&H" & str(i))
Next
UnicodeChar = desStr
Loi:
Exit Function
End Function

Function vnd(ByVal NumCurrency As Currency) As String
Static CharVND(9) As String, BangChu As String, i As Integer
Dim SoLe, SoDoi As Integer, PhanChan, Ten As String
Dim DonViTien As String, DonViLe As String
Dim NganTy As Integer, Ty As Integer, Trieu As Integer, Ngan As Integer
Dim Dong As Integer, Tram As Integer, Muoi As Integer, DonVi As Integer
NumCurrency = Round(NumCurrency, 0)
DonViTien = ";111;1ED3;6E;67" ' d?ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
vnd = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' S? l?n nh?t c?a lo?i CURRENCY
vnd = UnicodeChar(";4B;68;F4;6E;67;20;111;1ED5;69;20;111;1B0;1EE3;63;20;73" & _
";1ED1;20;6C;1EDB;6E;20;68;1A1;6E;20;39;32;32;2C;33;33;37" & _
";2C;32;30;33;2C;36;38;35;2C;34;37;37")
Exit Function
End If
CharVND(1) = ";6D;1ED9;74" ' m?t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' b?n
CharVND(5) = ";6E;103;6D" ' nam
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' b?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí s?
PhanChan = Trim$(str$(Int(NumCurrency)))
PhanChan = Space(15 - Len(PhanChan)) + PhanChan
NganTy = Val(Left(PhanChan, 3))
Ty = Val(Mid$(PhanChan, 4, 3))
Trieu = Val(Mid$(PhanChan, 7, 3))
Ngan = Val(Mid$(PhanChan, 10, 3))
Dong = Val(Mid$(PhanChan, 13, 3))
If NganTy = 0 And Ty = 0 And Trieu = 0 And Ngan = 0 And Dong = 0 Then
BangChu = ";6B;68;F4;6E;67;20" + DonViTien + ";20"
i = 5
Else
BangChu = ""
i = 0
End If
'-----------------------------------------------------
' Bat dau doi
'-----------------------------------------------------
While i <= 5
Select Case i
Case 0
SoDoi = NganTy
Ten = ";6E;67;E0;6E;20;74;1EF7" ' ngàn t?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' t?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trieu
Case 3
SoDoi = Ngan
Ten = ";6E;67;E0;6E" ' ngàn
Case 4
SoDoi = Dong
Ten = DonViTien ' dong
Case 5
SoDoi = SoLe
Ten = DonViLe ' xu
End Select
If SoDoi <> 0 Then
Tram = Int(SoDoi / 100)
Muoi = Int((SoDoi - Tram * 100) / 10)
DonVi = (SoDoi - Tram * 100) - Muoi * 10
If Right(BangChu, 3) = ";20" Then
BangChu = Left(BangChu, Len(BangChu) - 3)
End If
BangChu = BangChu + IIf(Len(BangChu) = 0, "", ";2C;20") + _
IIf(Tram <> 0, Trim(CharVND(Tram)) + ";20;74;72;103;6D;20", "")
If Muoi = 0 And Tram <> 0 And DonVi <> 0 Then
BangChu = BangChu + ";6C;1EBB;20"
Else
If Muoi <> 0 Then
BangChu = BangChu + IIf(Muoi <> 0 And Muoi <> 1, _
Trim(CharVND(Muoi)) + ";20;6D;1B0;1A1;69;20", ";6D;1B0;1EDD;69;20")
End If
End If
If Muoi <> 0 And DonVi = 5 Then
BangChu = BangChu + ";6C;103;6D;20" + Ten + ";20"
Else
If Muoi > 1 And DonVi = 1 Then
BangChu = BangChu + ";6D;1ED1;74;20" + Ten + ";20"
Else
BangChu = BangChu + IIf(DonVi <> 0, Trim(CharVND(DonVi)) + ";20" + Ten, Ten) + ";20"
End If
End If
Else
BangChu = BangChu + IIf(i = 4, DonViTien + "", "")
End If
i = i + 1
Wend
If SoLe = 0 Then
BangChu = BangChu + IIf(Right(BangChu, 3) = ";20", "", ";20") + ";63;68;1EB5;6E"
End If
BangChu = UnicodeChar(BangChu)
'Ðoi sang tieng Viet Unicode
' Ðoi chu cái dau tiên thành chu hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
vnd = BangChu
End Function

Untitled.png
 
Chào bạn,
Có thể mọi người chưa rõ mong muốn của bạn,
Ý của bạn là như thế nào?
- Bạn có đoạn code như trên nhưng chưa biết cách vận dụng nó? bạn muốn nhập một số ở textbox1 thì texbox2 chuyển số thành chữ (kiểu đọc số tiền)
- Bạn vận dụng được code trên, nhưng muốn nó chỉ chuyển thành chữ (không phải đọc số tiền)
 
Upvote 0
Chào bạn,
Có thể mọi người chưa rõ mong muốn của bạn,
Ý của bạn là như thế nào?
- Bạn có đoạn code như trên nhưng chưa biết cách vận dụng nó? bạn muốn nhập một số ở textbox1 thì texbox2 chuyển số thành chữ (kiểu đọc số tiền)
- Bạn vận dụng được code trên, nhưng muốn nó chỉ chuyển thành chữ (không phải đọc số tiền)
code trên mình đã biết cách vận dụng trong excel là =vnd(150000) nhưng khi đưa vào vba mình dùng như sau mà không được, không biết làm sao để texbox2 chuyển số thành chữ (kiểu đọc số tiền) bạn biết chỉ mình với, xin cảm ơn nhiều :
Sub test()
TextBox2.Value = Application.WorksheetFunction.vnd(TextBox1.Value)
End Sub
 
Upvote 0
Code bạn viết chỉ mới là 1 thủ tục, muốn code đó hoạt động thì bạn cần thực thi nó.
Đối với mong muốn của bạn, mình có 2 đề xuất như bên dưới, bạn xem cái nào hợp lý với bạn nhất nhé:
- Tạo 1 Button và thực thi bằng sự kiện Click của Button
Mã:
Private Sub CommandButton1_Click()
    TextBox2.Value = vnd(TextBox1.Value)
End Sub
- Thực thi bằng sự kiện Exit của Textbox1
Mã:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox2.Value = vnd(TextBox1.Value)
End Sub
Bạn thử xem nhé.
 
Upvote 0
Code bạn viết chỉ mới là 1 thủ tục, muốn code đó hoạt động thì bạn cần thực thi nó.
Đối với mong muốn của bạn, mình có 2 đề xuất như bên dưới, bạn xem cái nào hợp lý với bạn nhất nhé:
- Tạo 1 Button và thực thi bằng sự kiện Click của Button
Mã:
Private Sub CommandButton1_Click()
    TextBox2.Value = vnd(TextBox1.Value)
End Sub
- Thực thi bằng sự kiện Exit của Textbox1
Mã:
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox2.Value = vnd(TextBox1.Value)
End Sub
Bạn thử xem nhé.
Đúng như ý mình muốn. Cảm ơn bạn nhiều nhé.
 
Upvote 0
Web KT

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

Back
Top Bottom