Windows2000、OfficeXPです。
エクセルVBAでタイマーを作ろうとしたのですが、
作り始めてTimerコントロールがないのに気付きました。
VB6だったら簡単なのに・・・。
エクセルでの作業時間を正確に記録するためですので
VB6で作ると、時間の受け渡しができなくて困っています。
何かいい方法はありませんでしょうか?
よろしくお願いします。
具体的にどのようなことをされたいのか良くわかりませんが、Timer 関数
では精度が不足ということでしょうか?
VBA や VBS で実行時間を計測・表示するのに、私はよく使っていますが。
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
残念ながらVBAではできませんので、処理の主要ループに現在時間、
または経過時間などを計算するSubモジュールをCallするようにし、
自前で実現するしかないと思います。
VBを使用した経験がある方のようですので、それなりのプログラミングの
腕はお持ちと思いますので、あきらめて自作しましょう(^^)
VBAでプログレスバーだって工夫次第で実現可能ですので、デジタル時計くらい
なんてことは無いと思いますが?
VBAではTimeで現在時刻を読みとる事が出来ます。
また、NowでもOKです。
それを使えば、作業開始時間と終了時間の差を取れば良いだけかと思います。
確かに、おっしゃるとおりで、開始時間と終了時間を計算するだけで、
作業時間は取得できます。
ただ、やはり経過時間をデジタルで表示させたいのです。
そうですか、Timerコントロールはありませんか・・・。
y.sakudaさんのおっしゃるとおり、作ることにします。
ありがとうございました。 Kage
失礼しました。
うっかり、返信ボタンを押してしまいました。
"Kage" wrote in message
news:ux$Foe8vD...@TK2MSFTNGP09.phx.gbl
> エクセルVBAでタイマーを作ろうとしたのですが、
> 作り始めてTimerコントロールがないのに気付きました。
> VB6だったら簡単なのに・・・。
どうしてもタイマーが欲しければ、強引に作らないといけません。
サブクラス化するとデバッグしにくいですけど。
FindWindowでハンドルを取得するところがちょっと苦しい。
'UserForm1
Dim hWnd As Long
Private Sub UserForm_Activate()
hWnd = FindWindow(0, "UserForm1")
gOrgWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf TimerProc)
SetTimer hWnd, ID_TIMER1, 1000, _
AddressOf TimerProc
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Deactivate()
KillTimer hWnd, ID_TIMER1
SetWindowLong hWnd, GWL_WNDPROC, gOrgWndProc
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1.Text = 1
End Sub
'標準モジュール
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Public Declare Function SetWindowLong Lib "user32.dll" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_STYLE = (-16)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_HINSTANCE = (-6)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_ID = (-12)
Public Const GWL_USERDATA = (-21)
Public Declare Function CallWindowProc Lib "user32.dll" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function SetTimer Lib "user32.dll" _
(ByVal hWnd As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32.dll" _
(ByVal hWnd As Long, _
ByVal uIDEvent As Long) As Long
Public Const WM_TIMER = &H113
Public Const ID_TIMER1 = &H100
Public gOrgWndProc As Long
Public Function TimerProc(ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Select Case msg
Case WM_TIMER
UserForm1.TextBox1.Text = UserForm1.TextBox1.Text + 1
End Select
TimerProc = CallWindowProc(gOrgWndProc, _
hWnd, msg, wParam, lParam)
End Function
--
************************************************************
落藤 勇一郎
************************************************************
Excel2000 以降限定で、秒単位でよろしければこんな方法でいかがでしょう?
クラスモジュールを挿入して、名前を TimerClass とします。
(めちゃ手抜きですが)下記変数宣言だけ記述します。
Public Enabled As Boolean, Interval As Date
標準モジュールには、下記コードを記述します。
Dim aTimer As TimerClass
Sub StartTimer()
Set aTimer = New TimerClass
aTimer.Interval = TimeValue("00:00:01")
aTimer.Enabled = True
DispTime
End Sub
Sub StopTimer()
aTimer.Enabled = False
End Sub
Private Sub DispTime()
On Error Resume Next
With aTimer
Application.OnTime Now + .Interval, "DispTime", , .Enabled
End With
On Error GoTo 0
ActiveSheet.Cells(1) = TimeValue(Now)
End Sub
Excel 画面から、StartTimer を呼ぶと時計表示を開始し、StopTimer で
表示更新を停止します。
Excel97 だと、自身を OnTime メソッドで登録することができないので、
VBS 若しくは 別インスタンスの Excel を起動してコールバックさせる
等、複雑なことをしなければなりません。(秒未満の精度を出せますが)
# VBS からコールバックさせる方法は、Excel と Word のカテゴリで
# 以前投稿しています。
# 昨年11月「Re: 水平スクロールバーが押された事を知るには?」
# 本年 3月「Re: マクロを一定間隔で自動起動したいのですが」
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
実はクラスモジュールと言うのはどういう使い方をするのか知りませんでしたし
OnTimeメソッドも知ってはいたのですが、ニーズを感じたことがなく、
投稿を見てもぴんと来ず、Helpとしばらくにらめっこしてました。 なるほど・・・・
> クラスモジュールを挿入して、名前を TimerClass とします。
> (めちゃ手抜きですが)下記変数宣言だけ記述します。
ここまで教えていただいて、感謝感激です。
ヒントをいただいて、「Classだな・・・」とは思いましたが、
先日来、Classの壁にいろいろなことでぶち当たって
本や事例を見ますが、のどの上で詰まってしまう思いを
していました。
さっそく使わせていただきます。
ありがとうございました。 kage
今回のように、メンバー変数を Private にしないで直接読み書きできる
ようにするならば、Class を使う必然性はありません。
下記のように、ユーザー定義型を使っても可能ですし、単にモジュール
レベルで個別の変数を宣言するだけでも問題ないはずです。
最初は、Property Let やら Property Get を使って書きはじめたのですが、
面倒になりました。 だから Class としては「めちゃ手抜き」です(^_^;)
Type MyTimer
Interval As Date
Enabled As Boolean
End Type
Dim aTimer As MyTimer
Sub StartTimer()
aTimer.Interval = TimeValue("00:00:01")
aTimer.Enabled = True
DispTime
End Sub
*** 後略 ***
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> 下記のように、ユーザー定義型を使っても可能ですし、単にモジュール
> レベルで個別の変数を宣言するだけでも問題ないはずです。
Classモジュールを開放して、書き直しました。
確かに動きます。
Classについて、しっかり勉強しなければいけませんね。
ところで、StopTimerをかけたとき、1秒進んでから停止します。
Intervalの値を変えてみましたが、まともな動きをしてくれません。
最初に、「1秒後との計測であれば・・・」と書かれていましたが、
致し方ないことなんでしょうね。
kage
OnTime メソッドの設定単位がたぶん最小 1秒ですから、Interval を
小さくしてもダメでしょう。
DispTime プロシージャのコードを下記のように修正したらいかが?
Private Sub DispTime()
If aTimer.Enabled Then
Application.OnTime Now + aTimer.Interval, "DispTime"
ActiveSheet.Cells(1) = TimeValue(Now)
End If
End Sub
これはこれで、ダイアログ表示等で更新が停止されていたときに問題が
あるかもしれません。
これ以上の精度を求めるなら、落藤 さんの API を駆使する方法を使うか、
既に言及した VBS を利用する方法を過去記事で検索してみてください
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> どうしてもタイマーが欲しければ、強引に作らないといけません。
> サブクラス化するとデバッグしにくいですけど。
> FindWindowでハンドルを取得するところがちょっと苦しい。
試してみました。
ちゃんと動きますが、フォームを動かそうとすると固まります。
APIだらけなので、どこをいじればいいのかよく分からなくて・・・。
教えてもらうばかりで、申し訳ありません。
Kage
"Kage" wrote in message
news:uFY9YRUw...@TK2MSFTNGP10.phx.gbl
> ちゃんと動きますが、フォームを動かそうとすると固まります。
ありゃ、モーダルになるからかな。
> APIだらけなので、どこをいじればいいのかよく分からなくて・・・。
修正版です。
> 教えてもらうばかりで、申し訳ありません。
気にしなくていいです。好きでやってますから。
また、なにかあれば言ってください。
'This WorkBook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
KillTimer hWnd, ID_TIMER1
SetWindowLong hWnd, GWL_WNDPROC, gOrgWndProc
End Sub
Private Sub Workbook_Open()
hWnd = FindWindow("XLMAIN", 0)
hWnd = FindWindowEx(hWnd, 0, "XLDESK", 0)
UserForm1.Show vbModeless
UserForm1.TextBox1.Text = 0
gOrgWndProc = SetWindowLong(hWnd, GWL_WNDPROC, _
AddressOf TimerProc)
SetTimer hWnd, ID_TIMER1, 1000, _
AddressOf TimerProc
End Sub
'標準モジュール
Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
Public Declare Function FindWindowEx Lib "user32" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As Long) As Long
Public hWnd As Long
<HTML>
<BODY>
<SCRIPT LANGUAGE="VBScript">
Dim tID, S
Function MoveTime()
Dim D
D = Timer - S
document.all("displayTime").innerText = _
FormatDateTime(D / 86400, 0) & _
Right(FormatNumber(D - Int(D), 1, False), 2)
End Function
Sub window_onload() ' 表示開始時に呼び出されます。
S = timer
tID = window.setInterval("MoveTime", 100) ' 間隔は 100ms
End Sub
Sub StopTimer() ' ダブルクリックで呼び出されます。
window.clearInterval tID
End Sub
</SCRIPT>
<DIV ID=displayTime ondblclick ="StopTimer"
STYLE= "position:absolute;top: 0;left: 0;width: 90;height: 20;
border:solid;border-color:lightblue;
background-color:darkblue;
color:yellow;text-align:center;font-weight:bold">
</DIV>
</BODY>
</HTML>
「コントロールツールボックス」バーを表示し、[コントロールの選択]
から、「DHTML Edit Control for IE5」を挿入し、適当にサイズを調節
します。
ユーザーフォームに挿入する場合は、「ツールボックス」の空白部分で
右クリック->「その他のコントロール」で標準外のコントロールを選択
できます。
標準モジュールには、下記コードを記述します。(コントロール名、
ファイルパス等は実態に合わせて書き換えて下さい。)
Sub StartTimer()
With ActiveSheet.DHTMLEdit1
.BrowseMode = True
.ScrollBars = False
.LoadURL "C:\My Documents\LapTime.htm"
End With
End Sub
表示のために使うコントロールとしては、他に「Microsoft Web Browser」
も使えますが、こちらはスクロールバーが消せないようです。
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> document.all("displayTime").innerText = _
> FormatDateTime(D / 86400, 0) & _
> Right(FormatNumber(D - Int(D), 1, False), 2)
ここの FormatDateTime で四捨五入が起きるので、1秒の桁が不正に
なります。
VBA 側からコントロールする/データ取得する等の改良も加えた方法は
次の通り。 (Worksheets(1) に、DHTMLEdit1 を挿入した場合)
htm ファイル(LapTime.htm Book と同じフォルダに保存する)
<Script Language = VBScript>
Dim tId, S
Sub MoveTimer()
Dim dS
dS = Timer - S
document.All("LapTime").innertext = _
FormatDateTime(Int(dS) / 86400, 0) & _
Right(FormatNumber(dS - Int(dS), 1), 2)
End Sub
Sub StartTimer()
S = timer
If tId <> 0 Then StopTimer
tId = window.setInterval("MoveTimer", 100)
End Sub
Sub StopTimer()
window.clearInterval tId
tId = 0
End sub
</Script>
<div id = LapTime
style = "position: absolute;
top:0;left:0;width:120;height:20;
border:solid;
border-color:lightblue;background-color:blue;
color:yellow;text-align:center;font-weight:bold">
</div>
Book の Workbook_Open イベントプロシージャ
Private Sub Workbook_Open()
With Worksheets(1).DHTMLEdit1
.BrowseMode = True
.ScrollBars = False
.LoadDocument ThisWorkbook.Path & "\LapTime.htm"
Do While .Busy: DoEvents: Loop
End With
Cells(1).Select
End Sub
標準モジュールのコード
Sub StartTimer()
With Worksheets(1).DHTMLEdit1
.DOM.Script.StartTimer
End With
End Sub
Sub StopTimer()
With Worksheets(1).DHTMLEdit1.DOM
.Script.StopTimer
MsgBox .All("LapTime").innerText
End With
End Sub
# そのうちマーキー付きのユーザーフォームでも作ってしまいそう。(-。-)y-゜゜゜
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> ありゃ、モーダルになるからかな。
もちろん、フォームのプロパティは変更しました。
時計を表示させて、エクセルで作業するのは問題ありません。
> 修正版です。
フォームを動かしても問題ありません。
が、立ち上げ時にエクセルが一旦閉じて(問題が発生したため・・・の
マイクロソフトに送信するか、の画面が出ます)から、再度エクセルが
立ち上がり、正常に動き出します。
ただ、フォームを×で閉じようとすると、「型が一致しない」と言ってエクセルが
閉じてしまいます。
さらに、カウントダウンのタイマーにして、○分○秒表示にしようと思い
VBエディターを立ち上げると、作業中にエクセルが閉じてしまいます。
以上ご報告申し上げます。
Excel2002+WindowsXP、Excel2002+Windows2000
kage
HTML版の時計、試させていただきました。
こんなことができるんですね(@_@)
非常に興味深くて
いろいろ試しましたが、困ったことが数点ありました。
①セル幅により、時計の位置が動く
ワークシート上にあるので、致し方ないことなんですが
できることなら固定したい。
②DHTML Edit Control for IE5のサイズ編集
どうにもぴったりになりません。
一度貼り付けてしまうと、後から編集できない・・・??
③時間の表示方法
「○分○秒」の表示にしたいので
dFun = Int(dS / 60) ←分
document.All("LapTime").innertext = _
dFun & "分" & Int(dS - dFun * 60) & "秒"
tId = window.setInterval("MoveTimer", 1000) ←100を1000に
と変更しました。が、「分」「秒」が文字化け(-_-;)
フォント指定をしてみましたがうまくいきません。
④時計のフラッシング
最終的には、カウントダウンタイマーとし、残り○秒から
時計のバックをフラッシングさせようと思っています。
が、・・・できるかな(もちろん私にです)???
もうちょっとお付き合いいただけると幸いです。 kage
"Kage" さんは、2003年12月18日 19:57 の
『Re: エクセルVBAでTimerコントロール』で、こう書かれました。
> いろいろ試しましたが、困ったことが数点ありました。
> (1)セル幅により、時計の位置が動く
これは、ちょっと意味がつかめません。
起動時に、コントロールの位置を設定すればよろしいのでは?
> (2)DHTML Edit Control for IE5のサイズ編集
これも、Workbook_Open イベントで幅と高さを設定すれば良いでしょう。
> (3)時間の表示方法
HTML ファイルの方に META タグで、文字のエンコードを指定して下さい。
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; CHARSET=shift-jis">
> (4)時計のフラッシング
これはこんな感じでいかがでしょう。
Const MaxdS = 120
Sub MoveTimer()
Dim dS, SS, MM
dS = Int(Timer - S)
MM = Right("0" & dS \ 60, 2)
SS = Right("0" & dS Mod 60, 2)
With document.All("LapTime")
.innertext = MM & "分" & SS & "秒"
If MaxdS - dS < 10 Then
If .style.backgroundcolor = "blue" Then
.style.backgroundcolor = "red"
Else
.style.backgroundcolor = "blue"
End If
End If
End With
End Sub
# インターバルが 1000ms だと間延びしますが。
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> > (1)セル幅により、時計の位置が動く
>
> これは、ちょっと意味がつかめません。
> 起動時に、コントロールの位置を設定すればよろしいのでは?
With Worksheets(1).DHTMLEdit1
.BrowseMode = True
.ScrollBars = False
.Height = 29
.Width = 95
.Left = 500
.Placement = xlFreeFloating ←この部分
.Top = 0
.LoadDocument ThisWorkbook.Path & "\LapTime.htm"
Do While .Busy: DoEvents: Loop
End With
Placementプロパティを設定して列幅や行高では動かなくなりました。
ただ、画面スクロールで時計が消えてしまいます。
ちょっと悩ましいところです。
> > (2)DHTML Edit Control for IE5のサイズ編集
>
> これも、Workbook_Open イベントで幅と高さを設定すれば良いでしょう。
上記の通り、できました。
> > (3)時間の表示方法
>
> HTML ファイルの方に META タグで、文字のエンコードを指定して下さい。
> <META HTTP-EQUIV="Content-Type" CONTENT="text/html; CHARSET=shift-jis">
これもできました。
フラッシングもちょっと間が長い気もしますが、十分と思います。
VBScriptもずいぶん使えますね。
MicrosoftのMSDNオンラインを参考にしましたが、Mod関数が
書かれていませんでした。
しかたなく、前回のメールのような書き方をしましたが、使えるんですね。
いろいろとご教授いただき、たいへんありがとうございました。
Kage
タイマー表示の更新のタイミングで、位置を調整すれば良いということ
なら、次のようにします。
Excel 側:ワークシートオブジェクトを引数として渡します。
Sub StartTimer()
Worksheets(1).DHTMLEdit1.DOM.Script.StartTimer Worksheets(1)
End Sub
HTML 側:ワークシートオブジェクトから、スクロール情報を取得して
コントロールの位置を調整します。
Dim tId, S, xlSheet, PX, PY ' 変数を追加
Sub MoveTimer()
Dim dS, SS, MM, P ' 変数を追加
dS = Int(Timer - S)
*** タイマー部分は省略 ***
With xlSheet.Application
P = xlSheet.Columns(.ActiveWindow.ScrollColumn).Left + 500
If P <> PX Then xlSheet.DHTMLEdit1.Left = P: PX = P
P = xlSheet.Rows(.ActiveWindow.ScrollRow).Top
If P <> PY Then xlSheet.DHTMLEdit1.Top = P: PY = P
End With
End Sub
'
Sub StartTimer(Caller) ' 仮引数の追加
S = timer
If tId <> 0 Then StopTimer
tId = window.setInterval("MoveTimer", 200)
Set xlSheet = Caller ' Worksheet オブジェクトを設定
End Sub
'
Sub StopTimer()
window.clearInterval tId
tId = 0
Set xlSheet = Nothing ' Worksheet オブジェクトを解放
End sub
# この DHTMLEdit コントロールって、非表示で使えばタイマーコントロール
# 代わりに十分使えますね。
# このスレッドは私自身にも非常に有益でした。 Kage さんに感謝します。
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
"Kage" wrote in message
news:uFpn1$TxDHA...@TK2MSFTNGP10.phx.gbl
> 4日間、留守をしまして、返事が遅れました。申し訳ありません・・・。
私も4日間留守をしてました。
> フォームを動かしても問題ありません。
> が、立ち上げ時にエクセルが一旦閉じて(問題が発生したため・・・の
> マイクロソフトに送信するか、の画面が出ます)から、再度エクセルが
> 立ち上がり、正常に動き出します。
> ただ、フォームを×で閉じようとすると、「型が一致しない」と言ってエクセルが
> 閉じてしまいます。
大変失礼いたしました。
変数hWndが競合しているようです。
というわけで修正版です。
今度こそ。
フォームは閉じれないようにしたほうがいいかもしれません。
> さらに、カウントダウンのタイマーにして、○分○秒表示にしようと思い
> VBエディターを立ち上げると、作業中にエクセルが閉じてしまいます。
VBエディターを立ち上げるときは、一旦ブックを閉じて、
マクロを無効にするで立ち上げてください。
> 以上ご報告申し上げます。
ご報告、ありがとうございます。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
KillTimer MyhWnd, ID_TIMER1
SetWindowLong MyhWnd, GWL_WNDPROC, gOrgWndProc
End Sub
Private Sub Workbook_Open()
MyhWnd = FindWindow("XLMAIN", 0)
MyhWnd = FindWindowEx(MyhWnd, 0, "XLDESK", 0)
UserForm1.Show vbModeless
UserForm1.TextBox1.Text = 0
gOrgWndProc = SetWindowLong(MyhWnd, GWL_WNDPROC, _
AddressOf TimerProc)
SetTimer MyhWnd, ID_TIMER1, 1000, _
AddressOf TimerProc
End Sub
Public MyhWnd As Long
> Sub StartTimer()
> Worksheets(1).DHTMLEdit1.DOM.Script.StartTimer Worksheets(1)
> End Sub
Worksheets(1)を引数として加えると、「引数の数が一致しない」と
エラーになってしまいます。
HTML側の記述は関係しないはずだし・・・。
> # この DHTMLEdit コントロールって、非表示で使えばタイマーコントロール
> # 代わりに十分使えますね。
> # このスレッドは私自身にも非常に有益でした。 Kage さんに感謝します。
こう言って頂くと、私もたいへんうれしく思います。
Kage
> VBScriptでもVBAでも MOD、¥ は関数ではなく演算子ですので、そちらを
> ご覧ください
おっしゃるとおり、VB6でも演算子ですね。
エクセルのワークシートでは関数として使うものですから
長い間、勘違いをしていたようです。
ご指摘、ありがとうございました。 kage
> 大変失礼いたしました。
> 変数hWndが競合しているようです。
> というわけで修正版です。
> 今度こそ。
すみません。同じでした。
私が勘違いしているかもしれませんので、やっていることの確認です。
(1)ThisWorkbookにWorkbook_BeforeCloseとWorkbook_Openを
コピーして貼り付け。
(2)標準モジュールを追加して「'標準モジュール」のコードを
コピーして貼り付け。
(3)ユーザーフォームを追加して、フォーム上にTextboxを追加。
コードの記載はなし。
(4)保存して、「マクロを有効」で立ち上げ。
> フォームは閉じれないようにしたほうがいいかもしれません。
「×」はとりたいのですが、「ControlBox」プロパティがフォームに
ないものですから・・・。
よろしくお願いします。 kage
> Worksheets(1)を引数として加えると、「引数の数が一致しない」と
> エラーになってしまいます。
> HTML側の記述は関係しないはずだし・・・。
HTML 側の記述も関係しますよ。
・(HTML 側の) StartTimer プロシージャに仮引数を加えたか?
・それを前と違うファイル名に変えて保存したりしなかったか?
・HTML 側を修正した後、Excel 側で修正した(新しいファイル名の)HTML
を再ロードしたか?
の3点を確認して下さい。
# ちなみに、私も2,3番目ではまりました。^_^;
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> すみません。同じでした。
> 私が勘違いしているかもしれませんので、やっていることの確認です。
> (1)ThisWorkbookにWorkbook_BeforeCloseとWorkbook_Openを
> コピーして貼り付け。
> (2)標準モジュールを追加して「'標準モジュール」のコードを
> コピーして貼り付け。
> (3)ユーザーフォームを追加して、フォーム上にTextboxを追加。
> コードの記載はなし。
> (4)保存して、「マクロを有効」で立ち上げ。
それで合ってます。
おそらくですが、私のコードが、エクセル一つ、ブックも一つを
想定してますので、他のブックが立ち上がっていたりすると
ダメです。
> > フォームは閉じれないようにしたほうがいいかもしれません。
>
> 「×」はとりたいのですが、「ControlBox」プロパティがフォームに
> ないものですから・・・。
Flag変数を作って、UserForm1のQueryCloseでキャンセルするとか
ですかね。
多分「×」を無効にするAPIもあるでしょうけど。
> ・HTML 側を修正した後、Excel 側で修正した(新しいファイル名の)HTML
> を再ロードしたか?
1,2番は問題ありません。
3番の意味がよく分かりません。
ちなみに現在のコードを載せます。問題ないはずなんですが・・・。
Kage
'EXCEL ThisWorkbook
Private Sub Workbook_Open() '多少手を加えています。
With Worksheets(1).DHTMLEdit1
.BrowseMode = True
.ScrollBars = False
.Height = 29
.Width = 95
.Left = 500
.Placement = xlFreeFloating
.PrintObject = False
.Top = 0
.LoadDocument ThisWorkbook.Path & "\LapTime.htm"
Do While .Busy: DoEvents: Loop
End With
Cells(1).Select
End Sub
'Excel Module1
Sub StartTimer()
Worksheets(1).DHTMLEdit1.DOM.Script.StartTimer Worksheets(1)
End Sub
Sub StopTimer()
Dim gTime As String
With Worksheets(1).DHTMLEdit1.DOM
.Script.StopTimer
gTime = .All("LapTime").innerText
End With
ActiveSheet.Cells(1) = Val(Left(gTime, 2)) * 60 + Val(Mid(gTime, 4, 2))
End Sub
Laptime.htm
<Script Language = VBScript>
Dim tId, S, xlSheet, PX, PY ' 変数を追加
Sub MoveTimer()
Dim dS, SS, MM, P ' 変数を追加
dS = Int(Timer - S)
MM = Right("0" & dS \ 60, 2)
SS = Right("0" & dS Mod 60, 2)
With document.All("LapTime")
.innertext = MM & "分" & SS & "秒"
If MaxdS - dS < 10 Then
If .style.backgroundcolor = "blue" Then
.style.backgroundcolor = "red"
Else
.style.backgroundcolor = "blue"
End If
End If
End With
With xlSheet.Application
P = xlSheet.Columns(.ActiveWindow.ScrollColumn).Left + 500
If P <> PX Then xlSheet.DHTMLEdit1.Left = P: PX = P
P = xlSheet.Rows(.ActiveWindow.ScrollRow).Top
If P <> PY Then xlSheet.DHTMLEdit1.Top = P: PY = P
End With
End Sub
Sub StartTimer()
S = timer
If tId <> 0 Then StopTimer
tId = window.setInterval("MoveTimer", 200)
Set xlSheet = Caller ' Worksheet オブジェクトを設定
End Sub
Sub StopTimer()
window.clearInterval tId
tId = 0
Set xlSheet = Nothing ' Worksheet オブジェクトを解放
End sub
</Script>
<FONT SIZE="5">
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; CHARSET=shift-jis">
<div id = LapTime
style = "position: absolute;
top:0;left:0;width:120;height:20;
border:solid;
border-color:lightblue;background-color:blue;
color:yellow;text-align:center;font-weight:bold;font-family:wabun;">
</div>
</FONT>
> > ・HTML 側を修正した後、Excel 側で修正した(新しいファイル名の)HTML
> > を再ロードしたか?
> 3番の意味がよく分かりません。
修正した HTML を保存したあと、手動で Workbook_Open イベントプロシージャ
を実行するか、Excel Book を開き直すかしないと、コントロールは修正前の
HTML のまま動いてしまうということです。
> ちなみに現在のコードを載せます。問題ないはずなんですが・・・。
*** 中略 ***
> Sub StartTimer()
> S = timer
> If tId <> 0 Then StopTimer
> tId = window.setInterval("MoveTimer", 200)
> Set xlSheet = Caller ' Worksheet オブジェクトを設定
> End Sub
HTML 側のこのプロシージャに仮引数がありません。
Sub StartTimer(Caller)
として下さい。(これが確認事項の1番目なんですけど...)
--
Miyahn?戌年うまれ
HQF0...@nifty.ne.jp
> HTML 側のこのプロシージャに仮引数がありません。
> Sub StartTimer(Caller)
> として下さい。(これが確認事項の1番目なんですけど...)
すみません、僕がバカでした。
引数が一致しなければ、プロシージャーの引数を確認すればいいのに
すっかり見落としていました。
このタイマーは使えますねヽ(^o^)丿
いい勉強になりました。ありがとうございました。 kage