VBA 在同一单元格中插入和删除字母表，并具有用于插入和删除的自定义时间输入

Question

Option Explicit

Dim isRunning As Boolean
Dim targetCell As Range
Dim alphabet As String
Dim timeDelay As Double

' Initialize variables and start animation
Sub StartAnimation()
    Dim cellAddress As String
    
    ' Set the target cell, alphabet, and delay (in seconds)
    cellAddress = "A1" ' Change this to your desired cell
    alphabet = "A"     ' The alphabet to insert
    timeDelay = 0.5     ' Time delay in seconds
    
    ' Initialize target cell and start
    Set targetCell = Range(cellAddress)
    isRunning = True
    AnimateCell
End Sub

' Stop the animation
Sub StopAnimation()
    isRunning = False
End Sub

' Handles the animation logic
Sub AnimateCell()
    If Not isRunning Then Exit Sub
    
    If targetCell.Value = alphabet Then
        targetCell.Value = ""  ' Delete the alphabet
    Else
        targetCell.Value = alphabet  ' Insert the alphabet
    End If
    
    ' Schedule the next toggle
    Application.OnTime Now + TimeSerial(0, 0, timeDelay), "AnimateCell"
End Sub

Answer 1

问题似乎出在不到一秒的时间延迟上。可以使用 user32.dll 函数来解决此问题。 设置定时器

在示例中，目标单元格被硬编码为 ActiveSheet 上的 A13 单元格。

Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, _
                                               ByVal nIDEvent As Long, _
                                               ByVal uElapse As Long, _
                                               ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _
                                                ByVal nIDEvent As Long) As Long
Dim targetcell As Range, tm As Long, isrunning As Boolean, alphabet As String

Sub timelessone()
Set targetcell = Range("a13")
isrunning = True
alphabet = "A"
tm = SetTimer(0, 0, 500, AddressOf AnimateCell)

End Sub

Sub AnimateCell()
    If Not isrunning Then Exit Sub
    
    If targetcell.Value = alphabet Then
        targetcell.Value = ""  ' Delete the alphabet
    Else
        targetcell.Value = alphabet  ' Insert the alphabet
    End If
    
End Sub
Sub canceltimer()
KillTimer 0, tm
End Sub

动画从调用

timelessone

方法开始，到调用

canceltimer

停止。