Question

Excel中VBA代码延迟执行问题

如下第一图，为我自己做的一个时钟，可以运行
还想搞个小鸡吃米，代码也可以执行，但是没有实现一秒点头一次的效果。代码看第二图
求大神指教，为什么不点头，怎么修改





Answer 1

sub delay(T as single)
dim T1 as single
t1=timer
do
doevents
loop while timer-t1<t
end sub

调用时，使用 delay 3 即可延时3秒。

除了用timer函数外，还可以使用gettickcount函数，不过使用它之前要声明它，过程与上面的过程差不多，只是参数便是毫秒作为单位了。

SLEEP函数延时是毫秒级的，精确度比较高，但它在延时时会占用很多系统时间，使操作系统暂时无法响应用户操作，所以在长延时的时候不适合使用它。

Answer 2

抬头和低头 合并在一起 就是吃米……放在一段里
sub 吃米()

原抬头代码
Application.OnTime Now + TimeValue("00:00:01"), "’ 吃米’"
原低头代码
end sub
尝试一下……

结合你的秒针 转角代码 加在一起也可以哦
重点：吃米的 这个段代码要 循环 重复调用才行！
在你的吃米 代码最后一行 再次调用 吃米 也尝试一下………………

追问

我开始就是合在一起的，单步执行可以完成动作，但是完全执行代码就看不见动作了

再次调用吃米也不管用。

这个小鸡吃米就是为了丰富表盘内容的~~

追答

那么 你的那个 钟表的 代码是什么样子的？你这个是 单独的程序 不与时钟 一起动作？
稍后 给你一个答复……看来要亲自测试一下才能回复你了……呵呵
使用 do loop 语句作为整段代码的内循环……
Sub ttt()
Do
activesheet.shapes(……
selection.shaperange……=30
'楼下的朋友的
T = Timer
Do While Timer < T + 0.5
DoEvents
Loop
activesheet.shapes(……
selection.shaperange……=-30
'楼下的朋友的
T = Timer
Do While Timer < T + 0.5
DoEvents
Loop
Loop
End Sub

追问

如楼上追问，帮忙看看，有什么好方法没~

追答

增加一个变量 控制小鸡的 抬头与 低头……
for a =6 to……
……
wait
if b mod 2 =0 then

抬头代码
else
低头代码
endif
b=b+1
……
next
去掉第二个 小鸡的延时……把小鸡 抬头与否 作为下次循环情况来判定……
或者
直接 使用一个 使用一个变量 来控制
b=30 '第一次 小鸡的转角
for……
…………
activesheet.shapes(……).select
selection.shaperange.rotation =b
b=b*(-1)
…………
这样只用 一条 小鸡的转角 语句 ……

追问

第一条完美运行，第二个估计不行
谢谢你哦

追答

第二个 也是没有什么问题的 与 For a……意思差不多 只不过 每次都把B值改变方向 而已……

祝你快乐！

Answer 3

将Application.Wait (Now + TimeValue("0:00:01"))

上面这句代码换成以下代码测试看是否可行：

T = Timer
Do While Timer < T + 0.5
    DoEvents
Loop

 循环将以0.5秒的间隔为一个停顿区间！

你的设想很有创意！！

追问

延迟问题已解决，新问题：代码执行时小鸡低头一秒抬头一秒，秒针才动一下（即2秒动一下），请问怎样调代码使小鸡和秒针都是一秒钟动一下（调为半秒貌似不可行，动作不显示）代码贴不了 了，超字数。

追答

将你的代码做如下修改试试：

Sub 挂钟()
   Dim a As Long, m as Integer, Bln as Boolean
   For a = 6 to 2147483647 step 6
       If Not Bln Then m = -35 Else m = 0
       Bln = Not Bln
       Activesheet.shapes("图片 6").select
       selection.shaperange.Rotation = a
       Activesheet.shapes("Group 24").select
       selection.shaperange.Rotation = m
   Next
   b = a mod 360
   '......    
End Sub

已经反复提交了N次，怎么回事，代码发不上去？？