Bàn về giải pháp thực hiện trước nhé.
Theo cách tôi làm sẽ có 2 cách thực hiện:
1. Mở file excel hợp đồng trên cho chạy ngầm, kiểm tra rồi hiện thông báo nếu có, còn không thì lẳng lặng mà đóng.
2. Dùng VbScrip để kết nối, mở file excel, kiểm tra và hiện thông báo.
2 cách trên đều phải dùng công cụ có sẳn trong Windows là "Task Schedule" trong Control Panel để thiết lập nhiệm vụ tự động khởi chạy file Excel hoặc file VbScript trên ở một thời gian cố định trong ngày/ tuần mà bạn muốn kiểm tra. Ví dụ: khi mở máy tính lên, sẽ chạy tự động lúc 9:00 AM mỗi ngày để kiểm tra.
Các bạn khác có cách nào khác nữa thì chia sẽ cách làm để tham khảo nhé.
Bàn về giải pháp thực hiện trước nhé.
Theo cách tôi làm sẽ có 2 cách thực hiện:
1. Mở file excel hợp đồng trên cho chạy ngầm, kiểm tra rồi hiện thông báo nếu có, còn không thì lẳng lặng mà đóng.
2. Dùng VbScrip để kết nối, mở file excel, kiểm tra và hiện thông báo.
2 cách trên đều phải dùng công cụ có sẳn trong Windows là "Task Schedule" trong Control Panel để thiết lập nhiệm vụ tự động khởi chạy file Excel hoặc file VbScript trên ở một thời gian cố định trong ngày/ tuần mà bạn muốn kiểm tra. Ví dụ: khi mở máy tính lên, sẽ chạy tự động lúc 9:00 AM mỗi ngày để kiểm tra.
Các bạn khác có cách nào khác nữa thì chia sẽ cách làm để tham khảo nhé.
Mình gửi ý tưởng nếu bằng hoặc nhỏ hơn ngày hiện tại thì sẽ thông báo tới ngày thanh toán
còn việc để mở ra file theo link thì chắc nhờ anh chị khác hỗ trợ thêm nhe, mình thì chưa thể làm được.
Cũng được 90% không hiểu nếu báo thì đúng nhưng dùng lệnh mở file thì chỉ mở được 1 sheet, do vòng lặp tiếp theo nó chạy trên sheet hiện hành là file vừa mở.
Anh chị xem sai ở đâu nhe
Private Sub Workbook_Open()
Dim wb As Workbook
Dim Sh As Worksheet
Dim C As Range
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Set Sh = Sheets("aa")
For i = 2 To 10
For Each C In Worksheets("aa").Range("B" & i)
If Date >= C Then
Windows("test.xlsb").Activate
MsgBox "Hop dong " & Range("C" & i).Value & " da toi han thanh toan. Mo file click OK"
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Range("C" & i).Value
wb.Close SaveChanges:=False
End If
Next C
Next i
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Dim wb As Workbook
Dim Sh As Worksheet
Dim C As Range
Dim i As Integer
On Error Resume Next
Application.ScreenUpdating = False
Set Sh = Sheets("aa")
For i = 2 To 10
For Each C In Worksheets("aa").Range("B" & i)
If Date >= C Then
Windows("test.xlsb").Activate
MsgBox "Hop dong " & Range("C" & i).Value & " da toi han thanh toan. Mo file click OK"
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & Range("C" & i).Value
wb.Close SaveChanges:=Fals
End If
Next C
Next i
Application.ScreenUpdating = True
End Sub
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Các anh chị cho em hỏi trường hợp này
Hàng ngày em sẽ mở máy tính
Em muốn vào lúc 9h00 và 15h00 mỗi ngày, máy tính tự động mở cửa sổ Excel
(vì trong excel của em đã có sẵn addins rồi và đã có code Sub Autpen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
Trong trường hợp này thì sẽ làm như thế nào?
P/s: máy em sử dụng win 7, trong máy có 2 office 2003 và 2010
Em cảm ơn!
Bạn tạo 2 cái task cho 2 khung giờ nhé. Chọn Daily, Start a program là đường dẫn trực tới file excel có macro tự chạy của bạn, không cần thông qua file vbs để chạy file excel.
Tôi chia sẻ cách dùng Task Schedule của Windows để chạy file VBScript. File vbs này sẽ kiểm tra file excel cột [Status] của bạn để tìm chữ "EXPIRED", nếu có sẽ hiện thông báo cho biết. Sau đó thì bạn muốn mở file lên kiểmm tra hay không thì tuỳ.
Nói về tổ chức file excel:
- Trong file của bạn, các cột dữ liệu nên rõ ràng, chuẩn hoá. Bạn nên tách cột ngày - cột StartDate hiện tại của bạn thành 2 cột: StartDate , End Date và định dạng ngày cho đúng kiểu. Hiện tại bạn phải dùng thêm hàm Right() để tách dữ liệu ngày hết hạn rồi mới tính toán. Cách này không hiệu quả, hạn chế dùng hàm hết mức có thể nếu CSDL của bạn có thể tổ chức hợp lý, chuẩn hoá. Như trường hợp của bạn, nếu bạn tách thêm cột ngày hết hạn (EndDate) thì chỉ cần so sách ngày với nhau là được rồi, không cần thêm hàm Right() vô làm gì cho nặng công thức.
- Nên đặt tên Sheet không có khoảng trắng để thuận tiện cho viết code. Tên file cũng không nên quá dài như hiện tại và nếu không có khoảng trắng luôn càng tốt. Những cái tên này sẽ được khai báo trong code nên càng chuẩn và ít thay đổi càng tốt.
Vd: Tên hiện tại "PVDR Contract Management Update until 2019" ==> "PVDRContractMgmt_YTD2019.xlsm" YTD: Year to date
Cách làm:
Trong file Excel:
- Tạo một hàm kiểm tra quá hạn bằng cách kiếm cái text "EXPIRED" ở cột J. Nếu có thì hiện thông báo.
- Trong demo này xem như các cột ngày tháng bạn định dạng đúng.
Hàm CheckExpDate()
Mã:
Sub KiemTraHD()
CheckExpDate "EXPIRED", "J"
End Sub
Function CheckExpDate(FindString As String, ColumnToCheck As String) As Boolean
Dim rngCheck As Range
Dim rng As Range
Dim SheetLastRow As Integer
SheetLastRow = Sheets("PeriodicalContractSunrise").Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Set rngCheck = Sheets("PeriodicalContractSunrise").Range("$" & ColumnToCheck & "$1:$" & ColumnToCheck & "$" & CStr(SheetLastRow))
With rngCheck
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng Is Nothing Then
CheckExpDate = True
MsgBoxUni "Có h" & ChrW(7907) & "p " & ChrW(273) & ChrW(7891) & "ng " & ChrW(273) & ChrW(7871) & "n h" & ChrW(7841) & "n ho" & ChrW(7863) & "c " & ChrW(273) & "ã quá h" & ChrW(7841) & "n c" & ChrW(7847) & "n ki" & ChrW(7875) & "m tra.", vbCritical + vbSystemModal, "C" & ChrW(7843) & "nh báo."
Else
CheckExpDate = False
End If
End With
Exit Function
End Function
Code cho file Vbs như sau: mở notepad.exe, copy đoạn code sau vào và lưu tên tuỳ ý và đổi đuôi .txt thành .vbs (vd: KiemTraQuaHanHD.vbs)
Mã:
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
' Tao Excel instances
Dim appExcel
Set appExcel = CreateObject("Excel.Application")
' Tat tat ca canh bao cua Excel
appExcel.DisplayAlerts = False
appExcel.AskToUpdateLinks = False
appExcel.AlertBeforeOverwriting = False
appExcel.FeatureInstall = msoFeatureInstallNone
' Luu duong dan file excel hien tai de sau nay tra ve duong dan goc
Dim strSaveDefaultPath
Dim strPath
strSaveDefaultPath = appExcel.DefaultFilePath
strPath = WshShell.CurrentDirectory
appExcel.DefaultFilePath = strPath
' Mo file excel
Dim oWb
Dim sWBFileName
sWBFileName = strPath & "\PVDR Contract Management Update until 2019.xlsm"
Set oWb = appExcel.Workbooks.Open(sWBFileName)
appExcel.Application.Visible = False
Dim strMacroName
strMacroName = "'" & strPath & "\PVDR Contract Management Update until 2019.xlsm'" & "!basFunctions.KiemTraHD"
On Error Resume Next
' Chay macro hoac function trong file excel
appExcel.Application.Run strMacroName '("basFunctions.KiemTraHD")
If Err.Number <> 0 Then
MsgBox "Co loi phat sinh"
' Khi co loi phat sinh thì xoa nó
End If
Err.Clear
On Error GoTo 0
oWb.Close acSaveNo
'oWb.Save
appExcel.DefaultFilePath = strSaveDefaultPath
Set oWb = Nothing
' Kiem tra xem co file excel nao khac dang chay thi khong Quit, nguoc lai thi quit.
If appExcel.Workbooks.Count = 0 Then
appExcel.Quit
End If
Set appExcel = Nothing
Set WshShell = Nothing
Bước kế tiếp là thiết lập trong windows để tự động chạy file .vbs này theo một thời gian chỉ định mà bạn muốn.
Vào Control Panel - Administrative tool - task schedule và thiết lập như hình hướng dẫn.
pen(), em chỉ cần mở cửa sổ excel thì code sẽ tự kích hoạt)
