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
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
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"
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ữ
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
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)
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
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
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
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
