Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


22501 / 76734 ←次へ | 前へ→

【59613】Re:現在時刻をリアルタイムに表示させたい
発言  Yuki  - 08/12/25(木) 11:05 -

引用なし
パスワード
   ▼K.K さん:
>こんばんは。質問内容はタイトル通りで、bookを開いてからを終了させるまでの間、シート上の、例えばA1に常に最新の時間を表示させたいのですが、何かいい方法はないでしょうか?

APIのSetTimerを利用してみました。
標準モジュールに
Option Explicit
Declare Function FindWindow Lib "user32.dll" _
             Alias "FindWindowA" _
            (ByVal lpClassName As String, _
             ByVal lpWindowName As String) As Long

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

Declare Function KillTimer Lib "user32" _
            (ByVal hwnd As Long, _
             ByVal nIDEvent As Long) As Long
Public TimerId As Long

Public Sub TimerProc(ByVal lHwnd As Long, _
           ByVal lMsg As Long, _
           ByVal lTimerID As Long, _
           ByVal lTime As Long)
  On Error GoTo TimerProc_Err
  Worksheets(1).Range("A1").Value = Format(Now(), "gge年m月d日 h時m分s秒")
  Exit Sub
TimerProc_Err:
  Timer_End
End Sub

Public Sub Timer_End()
  Dim lngRtnCode As Long
  If TimerId <> 0 Then
    lngRtnCode = KillTimer(Application.hwnd, TimerId)
    TimerId = 0
  End If
End Sub

ブックモジュールに
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Timer_End
End Sub

Private Sub Workbook_Open()
  On Error GoTo Workbook_Open_Err
  TimerId = SetTimer(Application.hwnd, 1&, 1000, AddressOf TimerProc)
  Exit Sub
Workbook_Open_Err:
  Timer_End
End Sub

4 hits

【59609】現在時刻をリアルタイムに表示させたい K.K 08/12/25(木) 1:04 質問
【59611】Re:現在時刻をリアルタイムに表示させたい マクロマン 08/12/25(木) 10:19 発言
【59613】Re:現在時刻をリアルタイムに表示させたい Yuki 08/12/25(木) 11:05 発言
【59614】Re:現在時刻をリアルタイムに表示させたい \n 08/12/25(木) 11:21 発言
【59616】Re:現在時刻をリアルタイムに表示させたい でれすけ 08/12/25(木) 17:08 発言
【59691】Re:現在時刻をリアルタイムに表示させたい ぱくぱく名無しさん 09/1/2(金) 19:38 発言
【59625】Re:現在時刻をリアルタイムに表示させたい 熊谷隆史 08/12/26(金) 12:57 発言

22501 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free