Cho hỏi code giám sát một ứng dụng

NgoctrinhUSA · 17/3/19

Em đang tập viết một chương trình nhỏ và đang cần một code VBA để giám sát xem bất cứ khi nào file excel A đang active thì giám sát ứng dụng B đang mở có bị đóng hay không ?

HeSanbi · 17/3/19

Vấn đề của bạn có thể làm được. Tuy nhiên bạn có thể nói rõ hơn, để xem tôi có giúp được gì không

Bạn xem sơ qua Code sau để thực hiện:

1. Tạo một Class Module: với tên là clsAppEvents và copy đoạn code sau bỏ vào

PHP:

Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookActivate(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook)
''Code giám sát của bạn ở đây
End Sub

2. Tạo một module với code là:

PHP:

Public MainApp As New clsAppEvents
'---------------------------------------------------------------
'                              Check App Running
'---------------------------------------------------------------
'Vào Tool / References / tìm chọn Microsoft Scripting Runtime
'để kiểm tra xem ứng dụng có đang mở không
Private Sub test_CheckAppPC()
  Debug.Print CheckAppPC("excel")
End Sub
Public Function CheckAppPC(appName$) As Boolean
  Dim Process As Object, App$
  For Each Process In GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _
        ("SELECT Name FROM Win32_Process WHERE Name = """ & _
        IIf(Not LCase$(appName) Like "*.exe", appName & ".exe", appName) & """", , 48)
       App = Process .Name
  Next
  Set Process = Nothing: GetPIDApp = App  <> ""
End Function
'Để giám sát liên tục kiểu Runtime bạn cần dùng Application.OnTime Now() + 1 giây ( là khoảng cách để kiểm tra)

3. Copy đoạn code sau vào Code của Workbook:

PHP:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
  Set MainApp.App = Application
  MsgBox "Saved: " & ThisWorkbook.Name
End Sub
Private Sub Workbook_Open()
  Set MainApp.App = Application
End Sub

Và Save file trên ở các dạng xlsm / xlsb/ xlam và copy file này vào thư mục khởi động cùng Excel
C:\Users\<Tên người dùng của bạn>\AppData\Roaming\Microsoft\Excel\XLSTART

NgoctrinhUSA · 17/3/19

HeSanbi đã viết:

Vấn đề của bạn có thể làm được. Tuy nhiên bạn có thể nói rõ hơn, để xem tôi có giúp được gì không

Bạn xem sơ qua Code sau để thực hiện:

1. Tạo một Class Module: với tên là clsAppEvents và copy đoạn code sau bỏ vào

PHP:

Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookActivate(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook)
''Code giám sát của bạn ở đây
End Sub

2. Tạo một module với code là:

PHP:

Public MainApp As New clsAppEvents
'---------------------------------------------------------------
'                              Check App Running
'---------------------------------------------------------------
'Vào Tool / References / tìm chọn Microsoft Scripting Runtime
'để kiểm tra xem ứng dụng có đang mở không
Private Sub test_CheckAppPC()
  Debug.Print CheckAppPC("excel")
End Sub
Public Function CheckAppPC(appName$) As Boolean
  Dim Process As Object, App$
  For Each Process In GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _
        ("SELECT Name FROM Win32_Process WHERE Name = """ & _
        IIf(Not LCase$(appName) Like "*.exe", appName & ".exe", appName) & """", , 48)
       App = Process .Name
  Next
  Set Process = Nothing: GetPIDApp = App  <> ""
End Function
'Để giám sát liên tục kiểu Runtime bạn cần dùng Application.OnTime Now() + 1 giây ( là khoảng cách để kiểm tra)

3. Copy đoạn code sau vào Code của Workbook:

PHP:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
  Set MainApp.App = Application
  MsgBox "Saved: " & ThisWorkbook.Name
End Sub
Private Sub Workbook_Open()
  Set MainApp.App = Application
End Sub

Và Save file trên ở các dạng xlsm / xlsb/ xlam và copy file này vào thư mục khởi động cùng Excel
C:\Users\<Tên người dùng của bạn>\AppData\Roaming\Microsoft\Excel\XLSTART

Cảm ơn bạn đã quan tâm mình sẽ test xem sao mong bạn giúp đỡ thêm

NgoctrinhUSA · 25/3/19

HeSanbi đã viết:

Vấn đề của bạn có thể làm được. Tuy nhiên bạn có thể nói rõ hơn, để xem tôi có giúp được gì không

Bạn xem sơ qua Code sau để thực hiện:

1. Tạo một Class Module: với tên là clsAppEvents và copy đoạn code sau bỏ vào

PHP:

Option Explicit
Public WithEvents App As Application
Private Sub App_WorkbookOpen(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookActivate(ByVal WB As Excel.Workbook)
If WB.Name = "File A" Then
''Code giám sát của bạn ở đây
End if
End Sub
Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook)
''Code giám sát của bạn ở đây
End Sub

2. Tạo một module với code là:

PHP:

Public MainApp As New clsAppEvents
'---------------------------------------------------------------
'                              Check App Running
'---------------------------------------------------------------
'Vào Tool / References / tìm chọn Microsoft Scripting Runtime
'để kiểm tra xem ứng dụng có đang mở không
Private Sub test_CheckAppPC()
  Debug.Print CheckAppPC("excel")
End Sub
Public Function CheckAppPC(appName$) As Boolean
  Dim Process As Object, App$
  For Each Process In GetObject("winmgmts:\\.\root\CIMV2").ExecQuery _
        ("SELECT Name FROM Win32_Process WHERE Name = """ & _
        IIf(Not LCase$(appName) Like "*.exe", appName & ".exe", appName) & """", , 48)
       App = Process .Name
  Next
  Set Process = Nothing: GetPIDApp = App  <> ""
End Function
'Để giám sát liên tục kiểu Runtime bạn cần dùng Application.OnTime Now() + 1 giây ( là khoảng cách để kiểm tra)

3. Copy đoạn code sau vào Code của Workbook:

PHP:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
  Set MainApp.App = Application
  MsgBox "Saved: " & ThisWorkbook.Name
End Sub
Private Sub Workbook_Open()
  Set MainApp.App = Application
End Sub

Và Save file trên ở các dạng xlsm / xlsb/ xlam và copy file này vào thư mục khởi động cùng Excel
C:\Users\<Tên người dùng của bạn>\AppData\Roaming\Microsoft\Excel\XLSTART

Co cách nào để không giật màn hình ko bạn mình chạy code trên để Check liên tục mỗi giây

HeSanbi · 26/3/19

Code của bạn như thế nào lại giật màn hình?

NgoctrinhUSA · 26/3/19

HeSanbi đã viết:
Code của bạn như thế nào lại giật màn hình?

dạ code như anh hướng dẫn ở trên ạ và em đã khắc phục được rồi ạ chúc anh một ngày nhiều may mắn

Cho hỏi code giám sát một ứng dụng

NgoctrinhUSA

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

NgoctrinhUSA

Thành viên hoạt động

NgoctrinhUSA

Thành viên hoạt động

HeSanbi

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

NgoctrinhUSA

Thành viên hoạt động

Bài viết mới nhất

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng