Đổi số ra chữ

  • Thread starter Xuan Nhien
  • Ngày gửi
X

Xuan Nhien

Thành viên sơ cấp
8/1/07
1
0
0
52
TPHCM
#1
Chào các bạn,
Trước đay mình co macro để đổi số ra chữ khi ứng dụng vào làm phiếu thu - chi.... Macro này do mình và bạn mình xem sách tạo ra, mình đã bị mất khi cài lại máy tính.
Bạn nào có cho mình xin và hướng dẫn mình tạo lại macro này với.
Cám ơn các bạn.
 
N

nguoiconxunui

Khách vãng lai
29/6/04
1,260
211
63
Bình Định
aso2pc.co.cc
#3
bạn vô thư viện phần add-in nhé
 
Nina

Nina

Thành viên thân thiết
20/12/06
68
0
6
Đâu đó trên WKT.
#5
Chao ban

Dể minh giúp bạn nha :
VD : ở phiếu thu chi Textbox Sotien
Ban vào Other đặt lại tên : Baonhieu
còn ở textbox ban dung dể đọc chữ ,bạn cũng vào Other dặt lại tên Rachu ,còn ở Control Sure bạn gõ : =Rachu([Baonhieu]),thế là OK
Có gì bạn hỏi thêm các cao thủ khác như anh Sơn,A Thuan

Function RaChu(BaoNhieu)
Dim KetQua, SOTIEN, NHOM, Chu, S1, s2, S3, Dich As String
Dim N, J, Vitri As Byte, S As Double, HANG, Doc, DEM
If BaoNhieu = 0 Then
KetQua = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
KetQua = "Soá quùa lôùn"
Else
GoSub LamViecDi
End If
End If
RaChu = UCase(Left(KetQua, 1)) + Mid(KetQua, 2)
Exit Function

LamViecDi:
If BaoNhieu < 0 Then
KetQua = "Tröø" & Space(1)
Else
KetQua = Space(0)
End If
SOTIEN = Format(Abs(BaoNhieu), "##############0.00")
SOTIEN = Right(Space(15) & SOTIEN, 18)
HANG = Array("None", "traêm", "möôi", "gì ñoù")
Doc = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For N = 1 To 6
NHOM = Mid(SOTIEN, N * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If N = 5 Then Chu = "ñoàng" & Space(1) Else Chu = Space(0)
Case ".00", ",00"
Chu = "chaün"
Case Else
S1 = Left(NHOM, 1): s2 = Mid(NHOM, 2, 1): S3 = Right(NHOM, 1)
Chu = Space(0): HANG(3) = Doc(N)
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)
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 N = 5) Then Dich = "leû" & Space(1)
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"
KetQua = KetQua & Chu
End If
Next N
Return
End Function
 
Nina

Nina

Thành viên thân thiết
20/12/06
68
0
6
Đâu đó trên WKT.
#6
Chao ban

Function RaChu(BaoNhieu)
Dim KetQua, SOTIEN, NHOM, Chu, S1, s2, S3, Dich As String
Dim N, J, Vitri As Byte, S As Double, HANG, Doc, DEM
If BaoNhieu = 0 Then
KetQua = "Khoâng ñoàng"
Else
If Abs(BaoNhieu) > 1E+15 Then
KetQua = "Soá quùa lôùn"
Else
GoSub LamViecDi
End If
End If
RaChu = UCase(Left(KetQua, 1)) + Mid(KetQua, 2)
Exit Function

LamViecDi:
If BaoNhieu < 0 Then
KetQua = "Tröø" & Space(1)
Else
KetQua = Space(0)
End If
SOTIEN = Format(Abs(BaoNhieu), "##############0.00")
SOTIEN = Right(Space(15) & SOTIEN, 18)
HANG = Array("None", "traêm", "möôi", "gì ñoù")
Doc = Array("None", "ngaøn tyû", "tyû", "trieäu", "ngaøn", "ñoàng", "xu")
DEM = Array("None", "moät", "hai", "ba", "boán", "naêm", "saùu", "baûy", "taùm", "chín")
For N = 1 To 6
NHOM = Mid(SOTIEN, N * 3 - 2, 3)
If NHOM <> Space(3) Then
Select Case NHOM
Case "000"
If N = 5 Then Chu = "ñoàng" & Space(1) Else Chu = Space(0)
Case ".00", ",00"
Chu = "chaün"
Case Else
S1 = Left(NHOM, 1): s2 = Mid(NHOM, 2, 1): S3 = Right(NHOM, 1)
Chu = Space(0): HANG(3) = Doc(N)
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)
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 N = 5) Then Dich = "leû" & Space(1)
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"
KetQua = KetQua & Chu
End If
Next N
Return
End Function
Dể minh giúp bạn nha :
VD : ở phiếu thu chi Textbox Sotien
Ban vào Other đặt lại tên : Baonhieu
còn ở textbox ban dung dể đọc chữ ,bạn cũng vào Other dặt lại tên Rachu ,còn ở Control Sure bạn gõ : =Rachu([Baonhieu]),thế là OK
Có gì bạn hỏi thêm các cao thủ khác như anh Sơn,A Thuan
 

Thành viên trực tuyến

Không có thành viên trực tuyến.

Xem nhiều