HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,591
- Được thích
- 3,991
- Giới tính
- Nam
Share mọi người code đóng toàn bộ ứng dụng , save file excel rồi tắt PC sau vài giây trong một cú click
Chạy: Call remote_pc_LRS (3, True, 15)
Để Hủy Shutdown:
Cách 1. Call remote_pc_LRS (code vào Workbook_AfterOpen, mở lại Workbook tự động hủy shutdown)
Cách 2. mở hộp thoại Run (Phím Window + R) gõ: shutdown -a
Chương trình gồm có:
1. Sub remote_pc_LRS gồm 3 biến:
- state: giá trị 1 là logout, 2 là restart, 3 là shutdown, giá trị khác là hủy tắc PC
- actionYes: True - Thực hiện ngay / False - hỏi xem có muốn tắt không
- num: số giây hẹn thực hiện
2. Function arrayAppSYS: là một mảng chứa các chương trình sẽ không đóng các ứng dụng này
Nếu muốn không đóng một chương trình nào đó, hãy thêm vào array
3. Function quit_app_running : dùng để dóng chương trình
True: đóng không cần hỏi/ False: hỏi trước khi đóng
4. Function close_excel gồm 2 biến:
- saveAll: True - save tất cả các workbook / False - Save file đang chỉnh sữa
- closeOK: True - đóng ứng dụng không hỏi/ False - hỏi trước khi đóng ứng dụng
Lưu Ý: Nhớ sao lưu file của các ứng dụng khác. Nhỡ Run tay thì hãy thử nó khi PC vừa mở, vào Excel và ấn Thử.
Đã quen tay cứ ấn thõa thích.
Chạy: Call remote_pc_LRS (3, True, 15)
Để Hủy Shutdown:
Cách 1. Call remote_pc_LRS (code vào Workbook_AfterOpen, mở lại Workbook tự động hủy shutdown)
Cách 2. mở hộp thoại Run (Phím Window + R) gõ: shutdown -a
Chương trình gồm có:
1. Sub remote_pc_LRS gồm 3 biến:
- state: giá trị 1 là logout, 2 là restart, 3 là shutdown, giá trị khác là hủy tắc PC
- actionYes: True - Thực hiện ngay / False - hỏi xem có muốn tắt không
- num: số giây hẹn thực hiện
2. Function arrayAppSYS: là một mảng chứa các chương trình sẽ không đóng các ứng dụng này
Nếu muốn không đóng một chương trình nào đó, hãy thêm vào array
3. Function quit_app_running : dùng để dóng chương trình
True: đóng không cần hỏi/ False: hỏi trước khi đóng
4. Function close_excel gồm 2 biến:
- saveAll: True - save tất cả các workbook / False - Save file đang chỉnh sữa
- closeOK: True - đóng ứng dụng không hỏi/ False - hỏi trước khi đóng ứng dụng
Lưu Ý: Nhớ sao lưu file của các ứng dụng khác. Nhỡ Run tay thì hãy thử nó khi PC vừa mở, vào Excel và ấn Thử.
Đã quen tay cứ ấn thõa thích.
PHP:
#If VBA7 Then
Public Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#Else
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Sub close_FileEXPLORER()
Dim lExplhwnd As Long
lExplhwnd = FindWindow("CabinetWClass", vbNullString) ' "ExploreWClass"'
If lExplhwnd Then
SendMessage lExplhwnd, &H112, &HF060&, ByVal 0&
End If
End Sub
Sub CloseAllWorkbooks()
Dim wb As Workbook
For Each wb In Workbooks
wb.Close False 'True -> Save
Next wb
End Sub
Sub test_close_excel()
close_excel , True
End Sub
Function close_excel(Optional save As Boolean = True, _
Optional closeOK As Boolean = False)
ThisWorkbook.save
Call close_FileEXPLORER
Call quit_app_running(closeOK)
Application.DisplayAlerts = False
Application.Quit
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = True
End Function
Function arrayAppSYS(Optional toArray2D As Boolean) As Variant
Dim m, dArr() As Variant, k: k = 0
arrayAppSYS = Array("ApplicationFrameHost.exe", "audiodg.exe", "backgroundTaskHost.exe", "CCleaner64.exe", "CocCocCrashHandler.exe", "CocCocUpdate.exe", "conhost.exe", "csrss.exe", "ctfmon.exe", "dllhost.exe", "dwm.exe", "explorer.exe", _
"fontdrvhost.exe", "fsnotifier64.exe", "GoogleCrashHandler.exe", "GoogleCrashHandler64.exe", "googledrivesync.exe", "gxxsvc.exe", "jusched.exe", "LockApp.exe", "lsass.exe", "Microsoft.Mashup.Container.NetFX40.exe", "MSASCuiL.exe", _
"nvcontainer.exe", "NVDisplay.Container.exe", "NVIDIA Web Helper.exe", "NvTelemetryContainer.exe", "obs-browser-page.exe", "OpenWith.exe", _
"RemindersServer.exe", "RemoteServerWin.exe", "RtkNGUI64.exe", "RuntimeBroker.exe", "SearchFilterHost.exe", "SearchIndexer.exe", _
"SearchProtocolHost.exe", "SearchUI.exe", "SecurityHealthService.exe", "services.exe", "SettingSyncHost.exe", "SgrmBroker.exe", "ShellExperienceHost.exe", "sihost.exe", "smss.exe", "SMSvcHost.exe", _
"spoolsv.exe", "sqlwriter.exe", "SteamService.exe", "steamwebhelper.exe", "svchost.exe", "SystemSettingsBroker.exe", "taskhostw.exe", "TeamViewer_Service.exe", "TiltWheelMouse.exe", "tv_w32.exe", _
"tv_x64.exe", "UniKeyNT.exe", "UnrealCEFSubProcess.exe", "update_notifier.exe", "wininit.exe", "winlogon.exe", "WmiPrvSE.exe", "WsxService.exe")
If toArray2D Then
ReDim dArr(1 To UBound(arrayAppSYS) + 1, 1 To 1)
For Each m In arrayAppSYS
k = k + 1
dArr(k, 1) = m
Next
arrayAppSYS = dArr
End If
End Function
Sub test_quit_app_running()
If quit_app_running Then Debug.Print 2
End Sub
Function quit_app_running(Optional ByVal bool As Boolean) As Boolean
Dim question
If Not bool Then question = MsgBox("Close Application Running?", 3): If question <> vbYes Then Exit Function
Dim objWMIcimv2 As Object, objProcess As Object, objList As Object, intError As Integer
Dim dArr
With MyPC
Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process")
For Each objProcess In objList
On Error Resume Next
If objProcess.Name Like "*" & ".exe" Then
dArr = Application.Match(objProcess.Name, arrayAppSYS, False)
If dArr Is Nothing Then
On Error Resume Next
intError = objProcess.Terminate
If intError <> 0 Then Debug.Print objProcess.Name
End If
End If
Next
End With
quit_app_running = True
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set sArr = Nothing
Set dArr = Nothing
End Function
Sub remote_pc_LRS(Optional ByVal state As Integer, _
Optional ByVal actionYes As Boolean = False, _
Optional num As Integer = 10)
Dim Result
Shell "shutdown -a", vbHide
If state <> 0 And Not actionYes Then
Result = MsgBox("Shutdown PC?", 3)
End If
If Result = vbYes Or actionYes Then
If state = 1 Then
Dim xWb As Workbook
For Each xWb In Application.Workbooks
If Not xWb.ReadOnly And Windows(xWb.Name).Visible Then
xWb.Save
End If
Next
ThisWorkbook.save
Shell "shutdown -l", vbHide
end if
If state = 2 Then Shell "shutdown -r -t " & num, vbHide
If state = 3 Then Shell "shutdown -s -t " & num, vbHide
close_excel , True
End If
End Sub
Lần chỉnh sửa cuối:
))
