カスタム検索
Office関連

 

トップページ > Office関連 > APIを使わないタイマー(Office VBA)

 

Sponsored Links

APIを使わないタイマー(Office VBA)

HTMLWindow2オブジェクト(IHTMLWindow2インターフェース)のsetIntervalメソッドを利用することで、APIを使用せずにタイマーを利用することができます。
このタイマー機能を利用することでModalDialogが表示された状態でもループ処理が行えるようになります。
※ moug にて、shiraさんから教えて頂いた方法でInternet Explorer 8環境でも動作確認できました。この場を借りてお礼申し上げます。

 

[ThisWorkbook]

Option Explicit

Private d As Object
Private TimerId As Long

Public Sub Sample()
  Call StartTimer
  MsgBox "タイマー処理を開始しました。" & vbCrLf & _
         "タイマーID:" & TimerId, vbInformation + vbSystemModal
  Call EndTimer
  MsgBox "タイマー処理を終了しました。", vbInformation + vbSystemModal
End Sub

Public Sub StartTimer()
  If TimerId <> 0& Then Exit Sub
  Set d = CreateObject("htmlfile")
  Set d.parentWindow.onhelp = Me
  TimerId = d.parentWindow.setInterval("onhelp.TimerProc", 10&, "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

Public Sub TimerProc()
  Static n As Long

  n = n + 1
  ActiveSheet.Range("A1").Value = n
End Sub

 

 

また、moug でshiraさんが載せられた他のサンプルコードも掲載しておきます(ログが流れてしまうので…)。

 

サンプルコード1  [ThisWorkbook]

Private m_TimerId As Variant
Private m_doc As Object
Const ATTRNAME = "VBATimerHandler"

Private 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

Private 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

Public Sub TimerProc()
    Debug.Print Now()
End Sub

 

サンプルコード2  [ThisWorkbook]

Private m_TimerId As Variant
Private m_doc As Object
Private m_sc As Object

Private 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

Private 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

Public Sub TimerProc()
    Debug.Print Now()
End Sub

トップページ > Office関連 > APIを使わないタイマー(Office VBA)