Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[Hàm] Thư viện hàm cần biết cho người mới học
#1
1-Hàm tính tuổi
=IIf((Year(Date())-Year([Ngaysinh]))<1,1,(Year(Date())-Year([Ngaysinh])))

=IIf((Year(Date())-Year([Ngaysinh]))<1,1,(Year(Date())-Year([Ngaysinh]))) & "  Tuổi"
 
2-Hàm lấy từ tuổi đến tuổi trong Query
+Ở hàng Field bạn nhập
Tuoi: IIf((Year(Date())-Year([Ngaysinh]))<1,1,(Year(Date())-Year([Ngaysinh])))
+Ở hàng Criteria bạn nhập
>=[Forms]![Form_Chon]![Text10]*1 And <=[Forms]![Form_Chon]![Text20]*1
+Lấy tuổi khi nhập từ ô Text Box có tên là Text10 và Text20
Hàm này được đặt trong Query để lấy tham số từ 2 hộp Text Box trên Form
 
 3-Hàm để lọc trong Query từ tháng, đến tháng và chọn năm
Hàm này ở cột Tháng là =Month(Ngaysinh)
Between [Forms]![Form_Bang_khai_sinh]![Text96] And [Forms]![Form_Bang_khai_sinh]![Text98]
 
1-Ô Text96 là nhập từ tháng
2-Ô Text98 là nhập đến tháng
3-Ô Năm nhập Year(Ngaysinh) bạn nhập
[Forms]![Form_Bang_khai_sinh]![Text100]
 
 
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan , HungSoft , sockvn
#2
4-Hàm tính tuổi thọ
=Year([Matngay])-Year([Ngaysinh])
 
5-Hàm tính tuổi đảng
=IIf((Year(Date())-Year([Ngayvaodang]))<1,1,(Year(Date())-Year([Ngayvaodang])))
 
6-Lấy ra đảng viên có tuổi đảng theo qui định
Hàm này trong Query
+Chèn thêm 1 cột tại dòng Field bạn nhập Expr1: Year(Date())-Year([Ngayvaodang])
+Tại mục Criteria bạn nhập 30 Or 40 Or 50 Or 60 Or 70 Or 80 Or 90
 
7-Hàm tính tuổi quân phục vụ quân đội
+Hàm lấy ra số năm quân đội
=IIf([Ngaynhapngu]<>0,Int(([Ngayraquan]-[Ngaynhapngu])/365),0)
 
+Hàm lấy ra số tháng quân đội
=IIf([Ngaynhapngu]<>0,Int((([Ngayraquan]-[Ngaynhapngu])-365)/30),0) Mod 12
 
8-Hàm lấy ngày tháng năm theo giờ hệ thống
="Hà Nội, ngày " & Day(Date()) & " tháng " & Month(Date()) & " năm " & Year(Date())
 
9-Truyền tham số từ ComboBox
[Forms]![Form_Chon]![Combo237]
 
10-Lấy thông tin từ ComboBox vào Report
=Forms!Form_Chon!Combo46.Text
 
 
11-Lấy thông tin từ TextBox vào Report từ năm đến năm
="Từ " & Forms!Form_Chon!Text284 & " đến " & Forms!Form_Chon!Text286
 
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan
#3
12-Lấy thông tin từ Sub Form về số sách mượn và trả
Thống kê số sách mượn
+Vẽ 1 hộp Text6 và nhập =Sum([Soluong])
+Trên Form vẽ hộp Text và nhập
=IIf([Bang_Muon_Sach subform2]!Text6<>0,[Bang_Muon_Sach subform2]!Text6,0)
Thống kê số sách trả
+Vẽ 1 hộp Text8 và nhập =Sum([Soluongtra])
+Hàm này ở trên Form để tính Số sách trả
=IIf([Bang_Muon_Sach subform2]!Text8<>0,[Bang_Muon_Sach subform2]!Text8,0)
 
13-Hàm làm tươi dữ liệu
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
 
14-Hàm đóng Form này và mở Form khác
DoCmd.Close acForm, "Form_Login", acSaveNo
DoCmd.OpenForm "Form_Chon"
DoCmd.Maximize
 
15-Hàm phóng to Form khi mở
+Hàm này ở mục Open
DoCmd.SelectObject acForm, "Form_Chon"
DoCmd.Maximize
 
 
16-Hàm lấy ra tên người tùy ý trong Query
Like "*" & [Forms]![Form_Chon]![Text171] & "*"
Chú giải: Hàm này lấy ra những người được nhập ở Text171
 
 
17-Hàm cắt lấy 2 số cuối của năm
=Mid(Year([Denngay]),3,2)
 
18-Thống kê tổng số tốt nghiệp loại từ Sub form lên Form
+Tại Sub Form ở phần cuối vẽ TextBox40 =Count(IIf([TNLoai]="Xuất sắc",1))
+Trên Form vẽ hộp TextBox và nhập =[Bang_SV subform]![Text40]
 
19-Thống kê số Nam, Nữ từ Sub form lên Form
+Tại Sub Form ở phần cuối vẽ TextBox30=Count(IIf([Gioi]="01",1))
+Trên Form vẽ hộp TextBox và nhập =[Bang_SV subform]!Text30
Ghi chú: Trong thí dụ này “01” là Nam, “02” là Nữ
 
20-Hàm lấy ra số SV là dân tộc ít người, số nam, nữ trong Report
=Sum(IIf([Nhom]="02",1,0))
=Sum(IIf([Gioi]="01",1,0))
=Sum(IIf([Gioi]="02",1,0))
 
 
21-Hàm lấy ra ngày, tháng, năm và chỉ lấy năm trong Access2003
+Hàm lấy ra năm hiện tại =Year(Date())
+Hàm lấy ra ngày, tháng, năm hiện tại =Date()
 
22-Hàm kẻ cột
        Me.Line (0, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (0.9 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (3.5 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (6.5* 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (9.5 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (11.5 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (13* 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (18* 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (21 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (22 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (24 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
        Me.Line (26.5 * 567, 0)-Step(0.01 * 567, 56 * 567), , BF
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn
#4
26- Hàm tự động chuyển Nam thành Mr và Nữ thành Ms
=IIf([Gioi]="01","Mr","Ms")
 
27- Hàm tự động chuyển Nam thành Ông và Nữ thành Bà
=IIf([Gioi]="01","Ông","Bà")
 
28- Hàm hiện thứ, ngày, giờ hiện tại trên Form
+Để hiện thứ
=IIf(Weekday(Now())=1,"CN",IIf(Weekday(Now())=2,"Hai",IIf(Weekday(Now())=3,"Ba",IIf(Weekday(Now())=4,"Tư",IIf(Weekday(Now())=5,"Năm",IIf(Weekday(Now())=6,"Sáu",IIf(Weekday(Now())=7,"Bảy")))))))
+Để hiện ngày hiện tại =Date()
+Để hiện giờ hiện tại =Time()
 
29- Hàm ở nút Exit Form đăng nhập để đóng và thoát chương trình
Application.Quit
 
    'DoCmd.Close
End Sub
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn
#5
30- Hàm cho hiện ảnh ở hộp ComboBox
If IsNull(MaCB) Then
MsgBox "Ma khong duoc trung"
Exit Sub
End If
CPath = Application.CurrentProject.Path
Dim cPathTapTinAnh As String, cTapTinAnh As String
cPathTapTinAnh = CPath & "\Anh\" & Me.MaCB & ".JPG"
'MsgBox cPath
    Me.Image10.Picture = cPathTapTinAnh
    Me.Image10.Visible = True
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn
#6
31-Hàm hiện ảnh trên Report không lệ thuộc vào đường dẫn tuyệt đối
+Mở Report và chèn 1 ảnh đặt tên là Anh
+Nháy vào dòng Report Header để có màu đen
+Nháy vào nút công cụ Properties
+Chọn nhãn Event
+Trong mục On Format chọn Code Builder và dán đoạn mã này vào
Me.Anh.Picture = GetDBPath() + "\Anh\" + Me.MaSV + ".jpg"
Chú ý: MaSV sẽ thay đổi là MaCB, mã này ở trường trong Report
Public Function GetDBPath() As String
    Dim strFullPath As String
    Dim I As Integer
 
    strFullPath = CurrentDb().Name
 
    For I = Len(strFullPath) To 1 Step -1
        If Mid(strFullPath, I, 1) = "\" Then
            GetDBPath = Left(strFullPath, I)
            Exit For
        End If
    Next
End Function
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn
#7
33-Hàm chuyển tiền từ số sang chữ trong Access bằng Unicode
+Tại ô hiện tiền bằng chữ nhập =Sosangchu([Sotien]) & " đồng."
+Nội dung của Module
Option Compare Database
Function Chu(chuso)
 
    Select Case chuso
    Case 1
        Chu = " mô" & ChrW(803) & "t "
    Case 2
        Chu = " hai "
    Case 3
        Chu = " ba "
    Case 4
        Chu = " bô" & ChrW(769) & "n "
    Case 5
        Chu = " n" & ChrW(259) & "m "
    Case 6
        Chu = " sa" & ChrW(769) & "u "
    Case 7
        Chu = " ba" & ChrW(777) & "y "
    Case 8
        Chu = " ta" & ChrW(769) & "m "
    Case 9
        Chu = " chi" & ChrW(769) & "n "
 End Select
 
 End Function
 
Function Chuoi_baso(nhom_baso)
 
 Dim phan_tram, phan_donvi, phan_chuc As Double
 Dim nhombaso As String
    nhombaso = nhom_baso
    nhom_baso = Int(nhom_baso)
    phan_tram = Int(nhom_baso / 100)
    phan_donvi = nhom_baso Mod 10
    nhom_baso = nhom_baso Mod 100
    phan_chuc = Int(nhom_baso / 10)
 
 If Len(nhombaso) = 3 And phan_chuc = 0 And phan_tram = 0 Then
    Chuoi_baso = " không tr" & ChrW(259) & "m le" & ChrW(777) & Chu(phan_donvi)
 ElseIf Len(nhombaso) = 3 And phan_tram = 0 Then
    Select Case phan_chuc
        Case 1
            Select Case phan_donvi
                Case 0
                    Chuoi_baso = " không tr" & ChrW(259) & "m m" & ChrW(432) & ChrW(417) & ChrW(768) & "i "
                Case 5
                    Chuoi_baso = " không tr" & ChrW(259) & "m m" & ChrW(432) & ChrW(417) & ChrW(768) & "i l" & ChrW(259) & "m "
                Case Else
                    Chuoi_baso = " không tr" & ChrW(259) & "m m" & ChrW(432) & ChrW(417) & ChrW(768) & "i l" & ChrW(259) & "m " & Chu(phan_donvi)
            End Select
           
        Case Else
            Select Case phan_donvi
                Case 0
                    Chuoi_baso = " không tr" & ChrW(259) & "m " & Chu(phan_chuc) & " m" & ChrW(432) & ChrW(417) & "i"
                Case 1
                    Chuoi_baso = " không tr" & ChrW(259) & "m " & Chu(phan_chuc) & " m" & ChrW(432) & ChrW(417) & "i mô" & ChrW(769) & "t"
                Case 5
                    Chuoi_baso = " không tr" & ChrW(259) & "m " & Chu(phan_chuc) & " m" & ChrW(432) & ChrW(417) & "i l" & ChrW(259) & "m"
                Case Else
                    Chuoi_baso = " không tr" & ChrW(259) & "m " & Chu(phan_chuc) & " m" & ChrW(432) & ChrW(417) & "i" & Chu(phan_donvi)
            End Select
    End Select
 
ElseIf phan_chuc = 0 And phan_tram = 0 Then
    Chuoi_baso = Chu(phan_donvi)
    Else
        Select Case phan_tram
           
            Case Is > 0
               
                Select Case phan_chuc
                   
                    Case 0
                        Select Case phan_donvi
                            Case 0
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m "
                            
                            Case Else
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & " le" & ChrW(777) & Chu(phan_donvi)
                        End Select
                       
                    Case 1
                        Select Case phan_donvi
                            Case 5
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & " m" & ChrW(432) & ChrW(417) & ChrW(768) & "i" & " l" & ChrW(259) & "m "
                            Case Else
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & " m" & ChrW(432) & ChrW(417) & ChrW(768) & "i" & Chu(phan_donvi)
                        End Select
                       
                    Case Else
                        Select Case phan_donvi
                            Case 0
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i "
                        
                            Case 1
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & ChrW(768) & "i mô" & ChrW(803) & "t "
                            Case 5
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & ChrW(768) & "i l" & ChrW(259) & "m "
                            Case Else
                                Chuoi_baso = Chu(phan_tram) & "tr" & ChrW(259) & "m " & Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i" & Chu(phan_donvi)
                       
                        End Select
 
 
                End Select
               
            Case Is = 0
                Select Case phan_donvi
                                   
                    Case 0
                        Select Case phan_chuc
                            Case 1
                                Chuoi_baso = "m" & ChrW(432) & ChrW(417) & "i"
                             Case Else
                                Chuoi_baso = Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i "
                         End Select
                    Case 1
                        Select Case phan_chuc
                            Case 0
                                Chuoi_baso = Chu(phan_donvi)
                            Case 1
                                Chuoi_baso = " m" & ChrW(432) & ChrW(417) & ChrW(768) & "i mô" & ChrW(803) & "t "
                            Case Else
                                Chuoi_baso = Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i mô" & ChrW(769) & "t "
                        End Select
                    Case 5
                        Select Case phan_chuc
                            Case 1
                                Chuoi_baso = " m" & ChrW(432) & ChrW(417) & ChrW(768) & "i l" & ChrW(259) & "m"
                            Case Else
                                Chuoi_baso = Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i l" & ChrW(259) & "m "
                        End Select
 
                    Case Else
                        Select Case phan_chuc
                            Case 0
                                Chuoi_baso = Chu(phan_donvi)
                            Case 1
                                Chuoi_baso = "m" & ChrW(432) & ChrW(7901) & "i" & Chu(phan_donvi)
                            Case Else
                                Chuoi_baso = Chu(phan_chuc) & "m" & ChrW(432) & ChrW(417) & "i" & Chu(phan_donvi)
                        End Select
 
                End Select
 
        End Select
      
    End If
 
End Function
Function cut32(S)
 
Dim i, n As Integer, k, x As String
    S = Trim(S)
    For i = 1 To Len(S)
        k = Mid(S, i, 1)
        If k = Chr(32) Then
             n = n + 1
        Else
             n = 0
        End If
        If n >= 2 Then
            k = ""
        End If
    x = x & k
    Next
    cut32 = x
End Function
Public Function sosangchu(so)
If so = Null Then
so = 0
End If
so = Val(so)
Dim Ngay, Thang, Nam
Dim phan_don_vi, phan_nghin, phan_trieu, phan_ty, phan_nghinty As Double
Dim chuoi As String, MyDate
MyDate = so
so = CDbl(Fix(Val(so)))
 
If Len(Format$(so, "###")) > 15 Then
    sosangchu = ""
    Exit Function
ElseIf so < 10 Then
        sosangchu = Trim(Chu(so))
ElseIf IsEmpty(so) Then
        sosangchu = ""
ElseIf IsDate(MyDate) Then
    Ngay = Day(MyDate)
    Thang = Month(MyDate)
    Nam = Year(MyDate)
    If Thang = 4 Then
        sosangchu = "Ngaøy " & LCase(sosangchu(Ngay)) & " thaùng tö naêm " & LCase(sosangchu(Nam))
    Else
        sosangchu = "Ngaøy " & LCase(sosangchu(Ngay)) & " thaùng " & LCase(sosangchu(Thang)) & " naêm " & LCase(sosangchu(Nam))
    End If
Else
    so = Int(so)
    phan_don_vi = Right(so, 3)
    so = Int(so / 1000)
    phan_nghin = Right(so, 3)
    so = Int(so / 1000)
    phan_trieu = Right(so, 3)
    so = Int(so / 1000)
    phan_ty = Right(so, 3)
    so = Int(so / 1000)
    phan_nghinty = Right(so, 3)
   
 
    If phan_don_vi <> 0 Then
        chuoi = Chuoi_baso(phan_don_vi)
    End If
 
    If phan_nghin <> 0 Then
        chuoi = Chuoi_baso(phan_nghin) & " nghi" & ChrW(768) & "n " & Trim(chuoi)
    End If
   
    If phan_trieu <> 0 Then
        chuoi = Chuoi_baso(phan_trieu) & " triê" & ChrW(803) & "u " & Trim(chuoi)
    End If
   
    If phan_ty <> 0 Then
        chuoi = Chuoi_baso(phan_ty) & " ty" & ChrW(777) & Trim(chuoi)
    End If
   
    If phan_nghinty <> 0 Then
        If phan_ty = 0 Then
            chuoi = Chuoi_baso(phan_nghinty) & " nghi" & ChrW(768) & "n " & Trim(chuoi) & " ty" & ChrW(777) & Trim(chuoi) & Trim(chuoi)
        Else
            chuoi = Chuoi_baso(phan_nghinty) & " nghi" & ChrW(768) & "n " & Trim(chuoi) & Trim(chuoi)
        End If
    End If
    chuoi = UCase(Left(Trim(chuoi), 1)) & Mid(Trim(chuoi), 2, Len(chuoi) - 1)
   
    sosangchu = Trim(cut32(chuoi))
End If
 
End Function
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan
#8
34-Hàm đọc ngày sinh sang chữ trong Access
+Tại ô hiển thị bằng chữ bạn nhập
="Ngày "+DocSo(Day([Ngaysinh]))+" tháng "+DocSo(Month([Ngaysinh]))+" năm "+DocSo(Year([Ngaysinh]))
+Nội dung Module
Function DocSo(x As String) As String
    Dim Donvi, Am As Boolean
    Donvi = Array("", "nghi" & ChrW(768) & "n ", "triê" & ChrW(803) & "u ", "ty" & ChrW(777) & " ")
    Dim so As String, chuoi As String, Temp As String, X1 As String, c As Byte, l As Byte, k As Byte, ChuoiDem As String
    Dim id As Byte
    x = Format(Val(x), "#"): Am = False
If Len(x) > 18 Then
    DocSo = "so qua lon"
    Exit Function
End If
If Left(x, 1) = "-" Then
    Am = True
    x = Right(x, Len(x) - 1)
End If
If x = 0 Then
    DocSo = "không"
    Exit Function
End If
'Xu ly doc nhung so >100 ty
l = Len(x)
c = Fix(l / 9)
If l Mod 9 = 0 Then
    k = 9
Else
    k = l Mod 9
End If
    X1 = Left(x, k)
    x = Right(x, l - k)
Do Until X1 = ""
    id = 0
    Do While (X1 <> "")
    If Len(X1) <> 0 Then
        so = Lay3so(X1)
        X1 = Left(X1, Len(X1) - Len(so))
        Temp = Tinh3so(so)
        so = Temp
        If so <> "" Then
          Temp = Temp + Donvi(id)
            chuoi = Temp + chuoi
        End If
        id = id + 1
    End If
Loop
l = Len(x)
c = Fix(l)
If (l <> 0) And (l Mod 9) = 0 Then
    k = 9
Else
    k = l Mod 9
End If
X1 = Left(x, k)
x = Right(x, l - k)
ChuoiDem = ChuoiDem & chuoi
chuoi = ""
If x = "" And X1 <> "" Then ChuoiDem = ChuoiDem & "ty" & ChrW(777) & " "
Loop
ChuoiDem = IIf(Am, "¢m " & Trim$(ChuoiDem), Left(ChuoiDem, 1) & Right(ChuoiDem, Len(ChuoiDem) - 1))
DocSo = ChuoiDem
End Function
Function Lay3so(x As String) As String
Dim so As String
If Len(x) >= 3 Then
so = Right(x, 3)
Else
so = Right(x, Len(x))
End If
Lay3so = so
End Function
Function Tinh3so(x As String) As String
Dim chuoi As String, Temp As String
Dim Flag0 As Boolean, Flag1 As Boolean
Temp = x
Dim KySo
KySo = Array("không", "mô" & ChrW(803) & "t", "hai", "ba", "bô" & ChrW(769) & "n", "n" & ChrW(259) & "m", " sa" & ChrW(769) & "u", "ba" & ChrW(777) & "y", "ta" & ChrW(769) & "m", "chi" & ChrW(769) & "n")
If Len(x) = 3 Then
If x <> "000" Then 'If Left(x, 1) <> 0 Then
    chuoi = KySo(Left(x, 1)) & " tr" & ChrW(259) & "m "
End If
    x = Right(x, 2)
End If
If Len(x) = 2 Then
    If Left(x, 1) = 0 Then
        If Right(x, 1) <> 0 Then
            chuoi = chuoi & "linh "
        End If
        Flag0 = True
    Else
        If Left(x, 1) = 1 Then
            chuoi = chuoi & " m" & ChrW(432) & ChrW(7901) & "i "
        Else
            chuoi = chuoi & KySo(Left(x, 1)) & " m" & ChrW(432) & ChrW(417) & "i "
            Flag1 = True
        End If
    End If
    x = Right(x, 1)
End If
If Right(x, 1) <> "0" Then
    If Left(x, 1) = "5" And Not Flag0 Then
        If Len(Temp) = 1 Then
            chuoi = chuoi & "n" & ChrW(259) & "m "
        Else
            chuoi = chuoi & "l" & ChrW(259) & "m "
        End If
    Else
        If Left(x, 1) = "1" And Not (Not Flag1 Or Flag0) And chuoi <> "" Then
            chuoi = chuoi & "mô" & ChrW(769) & "t "
        Else
            chuoi = chuoi & KySo(Left(x, 1)) & " "
        End If
    End If
End If
Tinh3so = chuoi
End Function
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan
#9
35-Hàm đọc tiền trong Excel bằng Unicode
Chú giải: ô chứa tiền là ô B1
+Tại ô hiện tiền bằng chữ nhập =sorachu(B1)
+Nội dung Module
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
 
'Ba.n su+?a la.i mo^.t chút hàm SoRaChu nhu+ du+o+'i ?ây. Ba.n lu+u ý, các chuo^~i chu+'a mã Unicode tie^'ng Vie^.t pha?i ?u+o+.c gõ chính xác, các da^'u cha^'m pha^?y ra^'t quan tro.ng.
 
Function SoRaChu(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
DonViTien = ";111;1ED3;6E;67" ' ?o^`ng
DonViLe = ";78;75" ' xu
If NumCurrency = 0 Then
SoRaChu = UnicodeChar(";4B;68;F4;6E;67;20" & DonViTien)
Exit Function
End If
If NumCurrency > 922337203685477# Then ' So^' lo+'n nha^'t cu?a loa.i CURRENCY
SoRaChu = 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" ' mo^.t
CharVND(2) = ";68;61;69" ' hai
CharVND(3) = ";62;61" ' ba
CharVND(4) = ";62;1ED1;6E" ' bo^'n
CharVND(5) = ";6E;103;6D" ' na(m
CharVND(6) = ";73;E1;75" ' sáu
CharVND(7) = ";62;1EA3;79" ' ba?y
CharVND(8) = ";74;E1;6D" ' tám
CharVND(9) = ";63;68;ED;6E" ' chín
SoLe = Int((NumCurrency - Int(NumCurrency)) * 100) ' 2 kí so^'
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
'-----------------------------------------------------
' Ba('t ?a^`u ?o^?i
'-----------------------------------------------------
While I <= 5
Select Case I
Case 0
SoDoi = NganTy
Ten = ";6E;67;E0;6E;20;74;1EF7" ' ngàn ty?
Case 1
SoDoi = Ty
Ten = ";74;1EF7" ' ty?
Case 2
SoDoi = Trieu
Ten = ";74;72;69;1EC7;75" ' trie^.u
Case 3
SoDoi = Ngan
Ten = ";6E;67;E0;6E" ' ngàn
Case 4
SoDoi = Dong
Ten = DonViTien ' ?o^`ng
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) ' ?o^?i sang tie^'ng Vie^.t Unicode
' ?o^?i chu+~ cái ?a^`u tiên thành chu+~ hoa
Mid$(BangChu, 1, 1) = UCase$(Mid$(BangChu, 1, 1))
SoRaChu = BangChu
End Function
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan
#10
36- Hàm chỉ ra nơi lưu File
+Chú ý: Trong bảng cần có 1 trường là Duongdan với Type là Memo
Dim selectedFilename As String
Dim item As Long
With Application.FileDialog(1)
    .AllowMultiSelect = False
    .Show:
    item = .SelectedItems.Count
   
    If item = 0 Then
    selectedFilename = ""
    Else
   
    selectedFilename = .SelectedItems(1)
    Me.Duongdan = selectedFilename
   
    End If
    End With
Đoạn mã tiếp theo
'Hàm mo file
Sub OpenFileWordOrExcel(fileName As String)
 
' cat lay dinh dang cua tep tin
Dim duoi As String
 duoi = Right(fileName, 3)
 
Dim oApp As Object
 
Dim oXL As Object
Dim oExcel As Object
Dim sFullPath As String
Dim sPath As String
'mediaPlayer.Visible = False
'If mediaPlayer.Enabled = True Then
'mediaPlayer.URL = ""
 
 
If duoi = "doc" Then
 
Set oApp = CreateObject(Class:="Word.Application")
oApp.Visible = True
oApp.Documents.Open fileName:=fileName
 
ElseIf duoi = "avi" Or duoi = "mp4" Or duoi = "flv" Or duoi = "mov" Or duoi = "mp3" Or duoi = "wma" Then
 
'mediaPlayer.Visible = True
'mediaPlayer.URL = fileName
 
ElseIf duoi = "exe" Then
 Call Shell(fileName, 1)
 
ElseIf duoi = "pdf" Then
Application.FollowHyperlink fileName
' ShellToFile(fileName,"","");
 'Call Shell(fileName, 1)
 
'mediaPlayer.Custom = fileName
 
ElseIf duoi = "xls" Then
 
'Mo file Excel trong access
 
Set oXL = CreateObject("Excel.Application")
 
On Error Resume Next
oXL.UserControl = True
On Error GoTo 0
With oXL
.Visible = True
.Workbooks.Open (fileName)
End With
End If
Chữ ký của truongtrungviet truongtrungviet,gia nhập Thủ Thuật Access từ 14-12 -15.
Reply
Những người đã cảm ơn maidinhdan , tronghieu9792 , caytregiavn77


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  [Hàm] Hàm tạo Mã (dùng cho Học Sinh, Sinh Viên, Cán Bộ, Hộ Khẩu....) Xuân Thanh 17 4,415 04-11-14, 12:25 AM
Bài mới nhất: tranthanhan1962
  Tạo số chứng từ tăng dần và reset lại theo yêu cầu người dùng Noname 10 5,873 03-09-14, 11:22 PM
Bài mới nhất: tqcuong

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ