Share Add-In “Tự động mở File Excel và thông báo ngày đến hạn”!
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:TamDenHan.xls . File "ThongBaoDenHan" lưu ở đâu cũng được
II/ File "DenHạn", sheet Y
1/ Nếu cột D5:D1000 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 https://www.giaiphapexcel.com/forum/showthread.php?77905-H%E1%BB%8Fi-v%E1%BB%81-l%C3%A2p-tr%C3%ACnh-t%E1%BB%B1-%C4%91%E1%BB%99ng-m%E1%BB%9F-file-theo-th%E1%BB%9Di-gian/page2
– Đã thử nghiệm chạy tốt trên Excel 2003 và 2010
Xin Cảm ơn!
Code chính
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:TamDenHan.xls"
With CreateObject("Scripting.FileSystemObject")
Workbooks.Open "D:TamDenHan.xls"
If .FileExists("D:TamDenHan.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 SubChào các ACE và các bạn!
Tôi mới biết đến bài viết này, nó rất tuyệt vời đối với công việc của tôi. Trân trong cảm ơn Hồng Vân và ace.
Sau 1 thời gian dùng, tôi muốn thay đổi 1 số điều kiện trong đó, như:
1. Cột D >1000;
2. Thay đổi cột: B,C,D,E thành E,F,G,H;
3. Thêm nút Back.Rất mong mọi người giúp đỡ.
Trân trọng!
Thay code này trong File:"ThongBaoDenHan"
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:TamDenHan.xls"
With CreateObject("Scripting.FileSystemObject")
Workbooks.Open "D:TamDenHan.xls"
If .FileExists("D:TamDenHan.xls") Then
With Application
.ScreenUpdating = 0
.DisplayAlerts = 0
.Workbooks.Open FileName
End With
Tmparr = Sheets("Y").Range("G5:G10000").Value
Sheets("Y").Range("E5:E10000").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([G5], [G65536].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, 5).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 5).Font.ColorIndex = 3
End If
If Today - Arr(i, 1) = -1 Then
CreateObject("WScript.Shell").Popup UniConvert(Text1, "VNI") & Cells(i + 4, 5).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 5).Font.ColorIndex = 7
End If
If Today - Arr(i, 1) = 0 Then
CreateObject("WScript.Shell").Popup UniConvert(Text2, "VNI") & Cells(i + 4, 5).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 5).Font.ColorIndex = 5
End If
If Today - Arr(i, 1) = 1 Then
CreateObject("WScript.Shell").Popup UniConvert(Text3, "VNI") & Cells(i + 4, 5).Value, , "THÔNG BÁO by H.V", vbOKOnly
Cells(i + 4, 5).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 SubChép Chép file "DenHan" (mới)vào thư mục D:TamDenHan.xls
Chưa hiểu lắm, lưu ý khi chạy code thì không Undo được
3. Thêm nút Back.
Nghe "chạy code thì không Undo được" buồn quá :confused:
<Application.OnUndo> Nó được tạo ra để vậy chơi taĐơn giản 1 ví dụ này thôi:
Public ABCDEF As String Sub setUndo() ABCDEF = [A10].value [A10].value = "Hè hé he" Application.OnUndo "SetForUndo", "getUndo" End Sub Sub getUndo() [A10].value = ABCDEF End Sub
www.giaiphapexcel.com/diendan/threads/share-add-in-t%E1%BB%B1-%C4%91%E1%BB%99ng-m%E1%BB%9F-file-excel-v%C3%A0-th%C3%B4ng-b%C3%A1o-ng%C3%A0y-%C4%91%E1%BA%BFn-h%E1%BA%A1n.78300/
Khóa học Power PI – Ứng dung trong Nhân sự
TỔNG QUAN KHÓA HỌC: POWER BI CHO NGÀNH NHÂN SỰ Khóa học Power BI cho Nhân sự được thiết kế dành riêng cho các...
Xem khóa học
Nghe "chạy code thì không Undo được" buồn quá :confused:
<Application.OnUndo> Nó được tạo ra để vậy chơi ta
Đơn giản 1 ví dụ này thôi:
Thì chạy code rồi ấn Undo thôi.
Application.OnUndo "SetForUndo", "getUndo"
nó gán macro getUndo vào nút Undo.
Public ABCDEF As String / Variant / "FSO" / New Collection / (Object) / CSDL / TXT / nhiều nhiều
ABCDEF là để lưu tạm Dữ liệu Undo.