Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

22501 / 76734

←次へ　｜　前へ→


	【59613】Re:現在時刻をリアルタイムに表示させたい

Yuki - 08/12/25(木) 11:05 -


	引用なし

	パスワード

▼Ｋ．Ｋさん：
>こんばんは。質問内容はタイトル通りで、ｂｏｏｋを開いてからを終了させるまでの間、シート上の、例えばＡ１に常に最新の時間を表示させたいのですが、何かいい方法はないでしょうか？

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

5 hits

▼

【59609】現在時刻をリアルタイムに表示させたい Ｋ．Ｋ 08/12/25(木) 1:04