Excel VBA質問箱 IV

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

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


3885 / 13645 ツリー ←次へ | 前へ→

【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 発言[未読]

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

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

【59611】Re:現在時刻をリアルタイムに表示させたい
発言  マクロマン  - 08/12/25(木) 10:19 -

引用なし
パスワード
   出来ないことはないですが、時刻を表示している間は他の作業が
出来なくなるかパフォーマンスが悪くなる可能性があります。

HTMLファイルで時計を表示するものを作成するかネットから入手して、
WebBrowserコントロールに表示、ではだめですか?

【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

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

引用なし
パスワード
   たとえばではなく、実際にやりたいことを記述したほうがよいのでは?
Excelに現在時刻を表示したいってユーザはほとんどいないだろうし。
(Windowsであればタスクバーに時間が表示されるわけだし。
そんな(CPUを使う)不要な機能いらない。)
勉強のためであってもVBAで使わない機能を勉強する必要性もない気もする。

【59616】Re:現在時刻をリアルタイムに表示させたい
発言  でれすけ  - 08/12/25(木) 17:08 -

引用なし
パスワード
   こんにちは。

日経PC21の2004年の表計算大会の技能賞に入賞した作品が
時刻の自動更新を実現したものでした。

pc.nikkeibp.co.jp/pc21/contest/2004/udej/prize1.shtml

具体的にどのようにしていたかは忘れてしまいましたが、
外部データの取り込みで、定期的に更新する機能を使っていたと思います。

バックナンバーが手に入ればいいのですが...

【59625】Re:現在時刻をリアルタイムに表示させたい
発言  熊谷隆史  - 08/12/26(金) 12:57 -

引用なし
パスワード
   D-HTMLの機能を利用する例もついでに
載せておきます。

参考)
http://scripting.cocolog-nifty.com/blog/2007/10/vbamsgbox_7811.html
# 一部、Yukiさんのコードをお借りしてます。

---
Option Explicit
'ブックモジュール
Private obj As Object
Private timerID As Long

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    obj.parentWindow.clearInterval timerID
End Sub

Private Sub Workbook_Open()
    Set obj = CreateObject("htmlfile")
    Set obj.parentWindow.opener = Me
    timerID = obj.parentWindow.setInterval("opener.func", 1000, "VBScript")
End Sub

Sub func()
  Worksheets(1).Range("A1").Value = Format(Now(), "gge年m月d日 h時m分s秒")
End Sub

【59691】Re:現在時刻をリアルタイムに表示させたい
発言  ぱくぱく名無しさん  - 09/1/2(金) 19:38 -

引用なし
パスワード
   こんばんは。

>日経PC21の2004年の表計算大会の技能賞に入賞した作品が
>時刻の自動更新を実現したものでした。
>
>pc.nikkeibp.co.jp/pc21/contest/2004/udej/prize1.shtml
>
>具体的にどのようにしていたかは忘れてしまいましたが、
>外部データの取り込みで、定期的に更新する機能を使っていたと思います。
>バックナンバーが手に入ればいいのですが...
ググったログから適当に推測すると、外部データの定期更新が1分おきに実施されることでNOWワークシート関数の計算が起こるのを利用したのかなあと。
ちなみに、外部データは同じブック(保存後に限る)を指定してもOKでした。
また、外部データのシートを非表示にすれば、勝手に変わっていく様が面白かったです。

ただ「0秒」の時に変わるわけではないので、タスクバーの時計と最大59秒ずれるのが気になりました。

なので、日経の回答のものは他の方法かもしれませんね。

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