Xin hỏi Code đóng video tắt sau 1 thời gian định trước

[nqdn2010]

Tôi có tập tin sau, giúp tôi Code yêu cầu 2):

1) Click vào nút lệnh sẽ phát video theo đường dẫn (Tôi đã làm được);

2) Sau khi video phát 18 giây, tự động đóng lại và trở lại sheet ban đầu.

Xin cảm ơn nhiều!

 

[nqdn2010]

Thực hiện trên UserForm thì được, nhưng bị báo dung lượng lớn. Mong sự chia sẻ.

Tôi có tập tin sau, giúp tôi Code yêu cầu 2):

1) Click vào nút lệnh sẽ phát video theo đường dẫn (Tôi đã làm được);

2) Sau khi video phát 18 giây, tự động đóng lại và trở lại sheet ban đầu.

Xin cảm ơn nhiều!

 

[befaint]

Mở bằng cái gì thì tìm trong 'Process' rồi 'Terminate' nó đi.

Canh thời gian thì dùng Sleep API cũng được.

Chỉ đưa từ khóa vậy thôi.

 

[nqdn2010]

Tôi test nhiều hướng không thành công. Anh cho code cụ thể giúp. Bí rồi

 

[ongke0711]

Tôi test nhiều hướng không thành công. Anh cho code cụ thể giúp. Bí rồi

- Bạn không có code nhảy thời gian (theo giây) để đối chiếu với thời gian muốn ngừng phát video.
- Dùng hàm Sleep API cũng được nhưng nó tạm ngưng hệ thống, nếu có tác vụ nào khác bạn muốn chạy thì cũng bị ảnh hưởng. Dùng Timer thì có cái khó chịu là màn hình hơi bị nhấp nháy, không biết có do máy mạnh yếu, card màn hình không, chứ máy tôi thì hơi lag.
- Để đóng 1 process thì dùng Shell + TaskKill.
Shell ("taskkill /f /im wmplayer.exe")

Option Explicit

Dim dStopTime As Date
Dim gCount As Date

Sub Timer()
    gCount = Now + TimeValue("00:00:01")
    Application.OnTime gCount, "VideoStop"
End Sub

Sub VideoStop()
    If dStopTime - gCount <= 0 Then
        Shell ("taskkill /f /im wmplayer.exe")
        Exit Sub
    End If
    Call Timer
End Sub

Sub PlayWMP()
    Dim oShell As Object
    Dim sPathfile As String

    Set oShell = CreateObject("Shell.Application")
    sPathfile = ThisWorkbook.Path & "\Video1.mp4"
    oShell.Open (sPathfile)
    dStopTime = Now + TimeSerial(0, 0, 19)
    Call Timer
End Sub

 

[nqdn2010]

Xin lỗi trả lời chậm trễ.
Cám ơn bạn trước
Để tôi test thử

 

[nqdn2010]

Ok ! tôi cũng có áp dung "Shell ("taskkill /f / ", do tôi sử dụng Win10, mặc định phát video không phải WMP, nhờ code của bạn tôi phát hiện và chỉnh sửa như bên dưới thấy tạm ổn, bạn xem góp ý hộ nhé. Cám ơn nhiều

Sub PlayWMP()
Dim oShell As Object
    Dim sPathfile As String
      sPathfile = ThisWorkbook.Path & "\Video1.mp4"
   Shell "C:\Program Files\Windows Media Player\wmplayer /new /fullscreen /play " & """" & sPathfile & """"
    Call Sleep(12000)
    Shell ("taskkill /f /im wmplayer.exe")
End Sub

 

[ongke0711]

...
Call Sleep(12000)
Shell ("taskkill /f /im wmplayer.exe")
...

Bạn chạy lênh Sleep thấy có bị đơ chương trình chiếu video không? Hoặc nhấp nháy.
Máy tôi thì bị vậy nên mới đổi qua Timer.

 

[nqdn2010]

Không, tôi chạy bình thường.
Chạy Timer máy bị báo lỗi

 

[ongke0711]

Không, tôi chạy bình thường.
Chạy Timer máy bị báo lỗi

View attachment 233564

Lỗi này do có 2 cái Sub VideoStop trùng tên thôi.

 

[nqdn2010]

Um, ok trời ko để ý. Chạy rất oke. Cám ơn bạn nhiều nhe