Tự chuyển ô tự động theo thời gian.

[lacquan1]

Mến chào các anh, chị!
Giả định tôi có 4 ô nhạc A1: Đô; B1: Rê; C1: Mi; D1: Fa. Làm sao mà con chỏ chạy lần lượt tự động cách đều nhau 1 giây từ A1 đến D1. Ý tôi muốn là giống tempo,
Thank.

 

[CHAOQUAY]

Mến chào các anh, chị!
Giả định tôi có 4 ô nhạc A1: Đô; B1: Rê; C1: Mi; D1: Fa. Làm sao mà con chỏ chạy lần lượt tự động cách đều nhau 1 giây từ A1 đến D1. Ý tôi muốn là giống tempo,
Thank.

Chạy thử code này xem sao

Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub abc()
Dim i, j
With Sheet1
    For j = 1 To 4
        DoEvents
        .Cells(1, j).Select
        Sleep (1000)
    Next j
End With
Beep
End Sub

 

[HeSanbi]

Thủ tục Sleep sẽ ngưng VBA thấp nhất là 1 giây

Vì vậy nên dùng hàm đợi Mili giây

#If VBA7 Then
Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If

Public ExitWaitTime As Boolean

Private Sub test_DelayMSec()
  DelayMSec 1000, True
End Sub

Sub DelayMSec(Optional ByVal MiliSecond% = 1000, _
              Optional ByVal IsDoEvent As Boolean = True)
    Dim Start&, Check&
    Start = GetTickCount&()
    ExitWaitTime = False
    Do
      If IsDoEvent Then DoEvents
      Check = GetTickCount&()
      If Check < Start Or Check > Start + MiliSecond Or ExitWaitTime Then Exit Do
    Loop
    ExitWaitTime = False
  End Sub

 

[CHAOQUAY]

Thủ tục Sleep sẽ ngưng VBA thấp nhất là 1 giây

Vì vậy nên dùng hàm đợi Mili giây

#If VBA7 Then
Public Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
#Else
Public Declare Function GetTickCount Lib "kernel32" () As Long
#End If

Public ExitWaitTime As Boolean

Private Sub test_DelayMSec()
  DelayMSec 1000, True
End Sub

Sub DelayMSec(Optional ByVal MiliSecond% = 1000, _
              Optional ByVal IsDoEvent As Boolean = True)
    Dim Start&, Check&
    Start = GetTickCount&()
    ExitWaitTime = False
    Do
      If IsDoEvent Then DoEvents
      Check = GetTickCount&()
      If Check < Start Or Check > Start + MiliSecond Or ExitWaitTime Then Exit Do
    Loop
    ExitWaitTime = False
  End Sub

"Thủ tục Sleep sẽ ngưng VBA thấp nhất là 1 giây"

Có lẽ cái này không đúng đâu bạn.
Bạn có thể sửa số trong ngoặc thành sleep(1) rồi bấm xem mấy giây.

 

[lacquan1]

Chạy thử code này xem sao

Option Explicit
#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub abc()
Dim i, j
With Sheet1
    For j = 1 To 4
        DoEvents
        .Cells(1, j).Select
        Sleep (1000)
    Next j
End With
Beep
End Sub

Rất cảm ơn bạn, muốn con chỏ nhảy đến ô nào thì ô đó tô màu và hết 4 ô thì quay về ô đầu, mục đích chạy thành vòng tròn ?

 

[CHAOQUAY]

Rất cảm ơn bạn, muốn con chỏ nhảy đến ô nào thì ô đó tô màu và hết 4 ô thì quay về ô đầu, mục đích chạy thành vòng tròn ?

Chạy thử code dưới đây

Option Explicit

#If VBA7 And Win64 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub abc()
Dim i, j
With Sheet1
    For j = 1 To 4
        DoEvents
        .Cells(1, j).Select
        
        .Cells(1, j).Interior.ThemeColor = xlThemeColorAccent6
        Sleep (500)
        .Cells(1, j).Interior.ThemeColor = xlThemeColorAccent5
        Sleep (350)
        .Cells(1, j).Interior.ThemeColor = xlThemeColorAccent4
        Sleep (150)
        
        .Cells(1, j).Interior.ThemeColor = xlNone
    Next j
    .Cells(1, 1).Select
End With
Beep
End Sub