Office中国论坛/Access中国论坛

标题: 【源码】三种不使用API实现的VBA定时器-摘录 [打印本页]

作者: 盗梦 时间: 2015-4-16 21:28
标题: 【源码】三种不使用API实现的VBA定时器-摘录
本帖最后由盗梦于 2015-4-16 21:39 编辑

想在VBA中实现定时器，当然Access中有窗体的Timer事件，不过在Excel或word ppt则没有这个事件。以下方法可弥补这个缺陷
搜索网上相关的知识点。找到三种不使用API的VBA定时器
本文并不是为了比较用API和不用API设置定时器的优劣，而是提供了在VBA中另一种设置定时器的方法。
摘录自：http://www.blogbus.com/pptaddins-logs/69416881.html

使用方法：
(1) 把下面代码拷入
PowerPoint:当前幻灯片（如Slide1）中
Excel: ThisWorkBook中
Word: ThisDocument中
(2) 执行StartTimer宏开始定时器，将在调试窗口中每秒输出数字n
(3) 中止定时器EndTimer

第一种：

Option Explicit
Private d As Object
Private TimerId As Long
Public Sub StartTimer()
If TimerId <> 0& Then Exit Sub
Set d = CreateObject("htmlfile")
Set d.parentWindow.onhelp = Me
TimerId = d.parentWindow.setInterval("onhelp.TimerProc", 1000&, "VBScript")
Debug.Print "定时器开始(" & Hex(TimerId) & ")"
End Sub
Public Sub EndTimer()
If TimerId = 0& Then Exit Sub
Call d.parentWindow.clearInterval(TimerId)
TimerId = 0& Set d = Nothing
Debug.Print "定时器结束"
End Sub
'在下面CALLBACK过程中输入你自己的代码
Public Sub TimerProc()
Static n As Long
n = n + 1
Debug.Print n
End Sub

复制代码

第二种：

Private m_TimerId As Variant
Private m_doc As Object
Const ATTRNAME = "VBATimer"
Public Sub StartTimer()
Const Script = "document.documentElement.getAttribute('" & ATTRNAME & "').TimerProc()"
EndTimer
Set m_doc = CreateObject("htmlfile")
m_doc.DocumentElement.setAttribute ATTRNAME, Me
m_TimerId = m_doc.parentWindow.setInterval(Script, 1000)
End Sub
public Sub EndTimer()
If m_doc Is Nothing Then Exit Sub
If Not IsEmpty(m_TimerId) Then
m_doc.parentWindow.clearInterval m_TimerId
m_TimerId = Empty
End If
m_doc.DocumentElement.removeAttribute ATTRNAME
Set m_doc = Nothing
End Sub
'在下面CALLBACK过程中输入你自己的代码
Public Sub TimerProc()
Static n As Long
n = n + 1
Debug.Print n
End Sub

复制代码

第三种：

Private m_TimerId As Variant
Private m_doc As Object
Private m_sc As Object
Public Sub StartTimer()
EndTimer
Set m_doc = CreateObject("htmlfile")
Set m_sc = CreateObject("ScriptControl")
With m_sc
.Language = "JScript"
.AddObject "o", Me
.AddCode "function f(){o.TimerProc()}"
End With
m_TimerId = m_doc.parentWindow.setInterval(m_sc.Eval("f"), 1000)
End Sub
public Sub EndTimer()
If m_doc Is Nothing Then Exit Sub
If Not IsEmpty(m_TimerId) Then
m_doc.parentWindow.clearInterval m_TimerId
m_TimerId = Empty
End If
Set m_sc = Nothing
Set m_doc = Nothing
End Sub
'在下面CALLBACK过程中输入你自己的代码
Public Sub TimerProc()
Static n As Long
n = n + 1
Debug.Print n
End Sub

复制代码

作者: roych 时间: 2015-4-17 08:57
JavaScript，又见JavaScript……就说嘛，没有API，基本逃不掉JS。只是如果客户端（例如IE）禁用了JS，不知道还能不能用？{:soso_e120:}

作者: 盗梦 时间: 2015-4-17 09:01

roych 发表于 2015-4-17 08:57
JavaScript，又见JavaScript……就说嘛，没有API，基本逃不掉JS。只是如果客户端（例如IE）禁用了JS，不知 ...

禁用了当然用不了

听说又有一种语言势要代替js-->Dart，正在观望

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)