Đổi số ra chữ

Thảo luận trong 'Tin học văn phòng' bắt đầu bởi Xuan Nhien, 9 Tháng sáu 2007.

3,129 lượt xem

  1. Xuan Nhien

    Xuan Nhien Thành viên sơ cấp

    Bài viết:
    1
    Đã được thích:
    0
    Nơi ở:
    TPHCM
    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.
     
    #1
  2. tamnt07

    tamnt07 Sống đơn giản, lấy nụ cười làm căn bản!

    Bài viết:
    5,065
    Đã được thích:
    443
    Nơi ở:
    The Capital
    Em nghĩ chắc bác muốn làm trong Excel, thế thì bác sang topic Excel và kế toán tìm là có đấy!
     
    #2
  3. nguoiconxunui

    nguoiconxunui Khách vãng lai

    Bài viết:
    1,255
    Đã được thích:
    219
    Nơi ở:
    Bình Định
    bạn vô thư viện phần add-in nhé
     
    #3
  4. ha_my

    ha_my Thành viên sơ cấp

    Bài viết:
    1
    Đã được thích:
    0
    Nơi ở:
    Hòa Lạc - Móng cái - Quảng Ninh
    Hôm nay tôi mới tham gia diễn đàn mới đọc được tin của bạn. Nếu bạn chưa kiếm được thì cho tôi mail của bạn. Tôi sẽ gửi cho. Phầm mềm này nhỏ mà hay lắm.
    di_vang_da_tu4577@yahoo.com là mail của tôi.
    Vậy nhé
     
    #4
  5. Nina

    Nina Thành viên thân thiết

    Bài viết:
    68
    Đã được thích:
    0
    Nơi ở:
    Đâu đó trên WKT.
    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
     
    #5
  6. Nina

    Nina Thành viên thân thiết

    Bài viết:
    68
    Đã được thích:
    0
    Nơi ở:
    Đâu đó trên WKT.
    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
     
    #6

Chia sẻ trang này