Xin hỏi code VBA để tự động chuyển đổi sheet làm việc (2 người xem)

[Phuongmai2015]

Em có 1 file excel mở 24/24 (file chiếu để mọi người đọc thông tin)
file gồm 4 sheet
Có cách nào để tự động luân chuyển giữa các sheet không ạ
Ví dụ:
- Sheet 1 chạy 15 giây chỉ chuyển sang sheet 2
- Sheet 2 chạy 15 giây chỉ chuyển sang sheet 3
- Sheet 3 chạy 15 giây chỉ chuyển sang sheet 4
- Sheet 1 chạy 15 giây chỉ chuyển sang sheet 1

Nhờ các anh, chị chỉ giáo. Em cảm ơn ạ

 

[HeSanbi]

Bạn thử chép mã dưới đây vào một module mới, và đổi tên các trang tính tương ứng, hoặc sử dụng tệp dưới

Option Explicit
Sub On_Open()
  SwitchOn
End Sub
Sub On_Close()
  SwitchOff
End Sub
Sub SwitchOn()
  AutoSwitchWorksheets 5, [Sheet1], [Sheet2], [Sheet3], [Sheet4]
End Sub

Sub SwitchOff()
  AutoSwitchWorksheets 0
End Sub

Sub AutoSwitchWorksheets(ByVal seconds As Integer, ParamArray shts())
  On Error Resume Next
  Static t As Date, s%, a As Collection
  Dim i, b As Boolean
  b = seconds > 3
  If b Then
    If t = 0 Then
      Set a = New Collection
      For Each i In shts
        If TypeName(i) = "Worksheet" Then a.Add i, CStr(ObjPtr(i))
      Next
      If a.Count = 0 Then MsgBox "Hay nhap trang tính vào thu tuc!", vbInformation: Exit Sub
    Else
      For i = 1 To a.Count
        If a(i) Is ActiveSheet Then a(IIf(i = a.Count, 1, i + 1)).Activate: Exit For
      Next
    End If
    t = Now + TimeSerial(0, 0, seconds): s = seconds
    GoSub o
  Else
    GoSub o: t = 0: Set a = Nothing: s = 0
  End If
Exit Sub
o:
  Application.ontime t, "'" & ThisWorkbook.Name & "'!'AutoSwitchWorksheets " & CStr(s) & "'", , b
Return
End Sub

 

[hoangtuan.net]

Em có 1 file excel mở 24/24 (file chiếu để mọi người đọc thông tin)
file gồm 4 sheet
Có cách nào để tự động luân chuyển giữa các sheet không ạ
Ví dụ:
- Sheet 1 chạy 15 giây chỉ chuyển sang sheet 2
- Sheet 2 chạy 15 giây chỉ chuyển sang sheet 3
- Sheet 3 chạy 15 giây chỉ chuyển sang sheet 4
- Sheet 1 chạy 15 giây chỉ chuyển sang sheet 1

Nhờ các anh, chị chỉ giáo. Em cảm ơn ạ

bạn thử code này:

Public Sub AutoSwitchSheets()
    Dim i As Integer
    For i = 1 To Worksheets.Count
        Worksheets(i).Activate
        Application.Wait (Now + TimeValue("00:00:15"))
    Next i
End Sub

 

[Hoàng Tuấn 868]

bạn thử code này:

Public Sub AutoSwitchSheets()
    Dim i As Integer
    For i = 1 To Worksheets.Count
        Worksheets(i).Activate
        Application.Wait (Now + TimeValue("00:00:15"))
    Next i
End Sub

Như thế này chỉ được 1 lần thôi, ở đây chạy 24/24 bạn ơi.

 

[hoangtuan.net]

Như thế này chỉ được 1 lần thôi, ở đây chạy 24/24 bạn ơi.

Dạ bác! Em thấy cách của bác HeSanbi quá tuyệt, mà lỡ đăng rồi nên không xóa nữa

 

[Phuongmai2015]

Public Sub AutoSwitchSheets() Dim i As Integer For i = 1 To Worksheets.Count Worksheets(i).Activate Application.Wait (Now + TimeValue("00:00:15")) Next i End Sub

Cảm ơn anh, em chạy code thì đã thấy chạy lần lượt từ sheet 1 ~ sheet 4 được rồi. Nhưng lại ko quay lại sheet 1 để chạy vòng mới đc ạ

Bài đã được tự động gộp: 26/1/24

Bạn thử chép mã dưới đây vào một module mới, và đổi tên các trang tính tương ứng, hoặc sử dụng tệp dưới

Option Explicit
Sub On_Open()
  SwitchOn
End Sub
Sub On_Close()
  SwitchOff
End Sub
Sub SwitchOn()
  AutoSwitchWorksheets 5, [Sheet1], [Sheet2], [Sheet3], [Sheet4]
End Sub

Sub SwitchOff()
  AutoSwitchWorksheets 0
End Sub

Sub AutoSwitchWorksheets(ByVal seconds As Integer, ParamArray shts())
  On Error Resume Next
  Static t As Date, s%, a As Collection
  Dim i, b As Boolean
  b = seconds > 3
  If b Then
    If t = 0 Then
      Set a = New Collection
      For Each i In shts
        If TypeName(i) = "Worksheet" Then a.Add i, CStr(ObjPtr(i))
      Next
      If a.Count = 0 Then MsgBox "Hay nhap trang tính vào thu tuc!", vbInformation: Exit Sub
    Else
      For i = 1 To a.Count
        If a(i) Is ActiveSheet Then a(IIf(i = a.Count, 1, i + 1)).Activate: Exit For
      Next
    End If
    t = Now + TimeSerial(0, 0, seconds): s = seconds
    GoSub o
  Else
    GoSub o: t = 0: Set a = Nothing: s = 0
  End If
Exit Sub
o:
  Application.ontime t, "'" & ThisWorkbook.Name & "'!'AutoSwitchWorksheets " & CStr(s) & "'", , b
Return
End Sub

cảm ơn anh ạ

 

[Hoàng Tuấn 868]

Dạ bác! Em thấy cách của bác HeSanbi ok, mà lỡ đăng rồi nên không xóa nữa

Như vậy mỗi vòng hết một phút, tính số phút trong 5 ngày làm việc rồi lồng thêm vòng lặp nữa với số lần tương ứng số phút 1 ngày x 5 liệu có được không nhỉ.

 

[VetMini]

Dạ bác! Em thấy cách của bác HeSanbi ok, mà lỡ đăng rồi nên không xóa nữa

ok chỉ có nghĩa là "được".
Nếu code tốt thì nói là tốt, dở thì nói là dở. Phê hàng mà nói ok thì tội nghiệp tác giả. Trừ phi bạn cố tình dùng nghĩa "được".

Code trên của bạn, lười biếng thì thêm dòng này trước Next i
If i >= WorkSheets.Count Then i = 0
Tuy nhiên, giải thuật của bạn không an toàn lắm. Lỡ đang làm việc mà người dùng đổi thứ tự Sheets thì tùm lum hết.

 

[hoangtuan.net]

ok chỉ có nghĩa là "được".
Nếu code tốt thì nói là tốt, dở thì nói là dở. Phê hàng mà nói ok thì tội nghiệp tác giả. Trừ phi bạn cố tình dùng nghĩa "được".

Code trên của bạn, lười biếng thì thêm dòng này trước Next i
If i >= WorkSheets.Count Then i = 0
Tuy nhiên, giải thuật của bạn không an toàn lắm. Lỡ đang làm việc mà người dùng đổi thứ tự Sheets thì tùm lum hết.

Dạ bác, để e sửa.