Hong.Van
Busy
- Tham gia
- 7/5/12
- Bài viết
- 2,330
- Được thích
- 1,763
Em xin chia sẻ Add-In "Tự động mở File Excel và thông báo ngày đến hạn"! như sau:
I/ Chép file "DenHan" vào thư mục D:\Tam\DenHan.xls . File "ThongBaoDenHan" lưu ở đâu cũng được
II/ File "DenHạn", sheet Y
1/ Nếu cột D5
1000 có cell ngày/tháng/năm thỏa điều kiện:
Trước ngày hiện hành (ngày hệ thống máy tính) 2 ngày, hay 1 ngày, hoặc bằng ngày hiện hành hoặc sau 1 ngày hiện hành. Thì khi ta mở File "ThongBaoDenHan" thì sẽ tự động kích họat File "DenHan" và sẽ hiện thông báo đồng thời tô màu chữ !
Trường hợp không có cell nào thỏa điều kiện nói trên thì File "DenHạn" tự đóng
Nếu chúng ta không muốn nó hiện thông báo nữa thì ta chọn chữ R ở cột E của dòng tương ứng
2/ Với các ngày kỷ niệm hàng năm thì ta nhập ngày tại C6:C18, cthức sẽ tính ở cột D của dòng tương ứng
3/ Còn các ngày khác thì ta nhập trực tiếp từ D19 trở xuống
III/ Các bạn có thể tạo File "ThongBaoDenHan" thành Add-In. Như vậy mỗi khi mở Excel lên thì nếu thỏa điều kiện nói trên thì sẽ tự động kích họat File "DenHan" và sẽ hiện thông báo!
----------------
P/s:Các Thầy cô & anh chị đóng góp ý kiến để File trên hữu dụng hơn!
- File này được bắt nguồn từ đây http://www.giaiphapexcel.com/forum/...âp-trình-tự-động-mở-file-theo-thời-gian/page2
- Đã thử nghiệm chạy tốt trên Excel 2003 và 2010
Xin Cảm ơn!
Code chính
I/ Chép file "DenHan" vào thư mục D:\Tam\DenHan.xls . File "ThongBaoDenHan" lưu ở đâu cũng được
II/ File "DenHạn", sheet Y
1/ Nếu cột D5
1000 có cell ngày/tháng/năm thỏa điều kiện:Trước ngày hiện hành (ngày hệ thống máy tính) 2 ngày, hay 1 ngày, hoặc bằng ngày hiện hành hoặc sau 1 ngày hiện hành. Thì khi ta mở File "ThongBaoDenHan" thì sẽ tự động kích họat File "DenHan" và sẽ hiện thông báo đồng thời tô màu chữ !
Trường hợp không có cell nào thỏa điều kiện nói trên thì File "DenHạn" tự đóng
Nếu chúng ta không muốn nó hiện thông báo nữa thì ta chọn chữ R ở cột E của dòng tương ứng
2/ Với các ngày kỷ niệm hàng năm thì ta nhập ngày tại C6:C18, cthức sẽ tính ở cột D của dòng tương ứng
3/ Còn các ngày khác thì ta nhập trực tiếp từ D19 trở xuống
III/ Các bạn có thể tạo File "ThongBaoDenHan" thành Add-In. Như vậy mỗi khi mở Excel lên thì nếu thỏa điều kiện nói trên thì sẽ tự động kích họat File "DenHan" và sẽ hiện thông báo!
----------------
P/s:Các Thầy cô & anh chị đóng góp ý kiến để File trên hữu dụng hơn!
- File này được bắt nguồn từ đây http://www.giaiphapexcel.com/forum/...âp-trình-tự-động-mở-file-theo-thời-gian/page2
- Đã thử nghiệm chạy tốt trên Excel 2003 và 2010
Xin Cảm ơn!
Code chính
Mã:
Sub Auto_Open()
Dim Today As Long, Tmparr, Item, tmp
Dim chk As Boolean, FileName$
Dim i, Arr(), Text As String, Text1 As String, Text2 As String, Text3 As String
Text = "CO2N 2 NGA2Y LA2 D9E61N: "
Text1 = "CO2N 1 NGA2Y LA2 D9E61N: "
Text2 = "HO6M NAY LA2: "
Text3 = "D9A4 QUA 1 NGA2Y: "
Debug.Print chk
Today = Date
FileName = "D:\Tam\DenHan.xls"
With CreateObject("Scripting.FileSystemObject")
Workbooks.Open "D:\Tam\DenHan.xls"
If .FileExists("D:\Tam\DenHan.xls") Then
With Application
.ScreenUpdating = 0
.DisplayAlerts = 0
.Workbooks.Open FileName
End With
Tmparr = Sheets("Y").Range("D5:D1000").Value
Sheets("Y").Range("B5:B1000").Font.ColorIndex = 1
For Each Item In Tmparr
If Len(Item) Then
tmp = CDate(Format(Item, "dd/mm/yyyy"))
If Today - tmp >= -2 And Today - tmp <= 1 Then chk = True
End If
Next
If chk Then
With Sheets("Y")
Arr = Range([D5], [D65536].End(3)).Resize(, 2)
For i = 1 To UBound(Arr)
If Arr(i, 1) <> "" And Arr(i, 2) = "" Then
If Today - Arr(i, 1) = -2 Then
CreateObject("WScript.Shell").Popup UniConvert(Text, "VNI") & Cells(i + 4, 2).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 2).Font.ColorIndex = 3
End If
If Today - Arr(i, 1) = -1 Then
CreateObject("WScript.Shell").Popup UniConvert(Text1, "VNI") & Cells(i + 4, 2).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 2).Font.ColorIndex = 7
End If
If Today - Arr(i, 1) = 0 Then
CreateObject("WScript.Shell").Popup UniConvert(Text2, "VNI") & Cells(i + 4, 2).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 2).Font.ColorIndex = 5
End If
If Today - Arr(i, 1) = 1 Then
CreateObject("WScript.Shell").Popup UniConvert(Text3, "VNI") & Cells(i + 4, 2).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 2).Font.ColorIndex = 50
End If
End If
Next
End With
Else
Workbooks("DenHan.xls").Close
End If
End If
End With
With Application
.ScreenUpdating = 1
.DisplayAlerts = 1
End With
End Sub
