アクセス小僧：時計（３） [コンピューター]
アクセス(VBA)で作った
時計のマクロのコードを公開します。
１．まず、フォームの画面イメージです。
２．フォームのVBAマクロです。
Option Compare Database
Private Sub Form_Load()
'【イベント】フォーム読込時
On Error GoTo ERR1
'【変数】
Dim ANS As Integer ' 答え
'【実行コード】
'タイマ間隔プロパティを0.1秒(100ms)に再設定
Me.TimerInterval = 100
[コンボ_単位時間146].Value = 100
' 単位時間をロック
[コンボ_単位時間146].Locked = True
' カウンタ初期化
[テキスト_counter92] = 0
' ラジオボタンをON
[オプション_日時78].Value = True
Me.AllowAdditions = True ' レコード追加許可
Me.AllowEdits = True ' 変更許可
Call SWStart ' 時間計測開始
GoTo CleanUp
ERR1:
ANS = MsgBox("エラー(フォーム読込時)" & vbCrLf & Err.Description, vbCritical, "エラー")
GoTo CleanUp
CleanUp:
[コマンド_日時再開74].SetFocus
End Sub
Private Sub Form_Timer()
'【イベント】タイマー時
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
Dim myFlag1 As Integer ' フラグ
'【実行コード】
Call SWStop ' 時間計測停止
Call SWStart ' 時間計測開始
If [オプション_画面更新151] = False Then
Application.Echo False, "処理中..." ' 画面更新停止
Else
Application.Echo True ' 画面更新再開
End If
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' カウンタ92をインクリメント
[テキスト_counter92] = [テキスト_counter92] + 1
' 1/10/100msec間隔
' アラーム確認
If ([オプション_日時78].Value = True) And ([オプション_アラーム88] = True) _
And (TimeSerial([コンボ_時81], [コンボ_分90], 0) = Time()) Then
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
[テキスト_日時72].Value = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
[オプション_アラーム88] = False ' アラームを止める
Call myHelp_WSH([コンボ_時81] & "時" & [コンボ_分90] & "分になりました。", "時間です")
End If
' タイマー
If ([オプション_タイマー96].Value = True) And ([テキスト_counter104].Value >= 0) Then
If [オプション_高精度157] = True Then
[テキスト_counter104].Value = [テキスト_counter104].Value - [テキスト_処理時間154].Value ' 減算
If [テキスト_counter104].Value < 0 Then
[テキスト_counter104].Value = 0
End If
Else
[テキスト_counter104].Value = [テキスト_counter104].Value - 1 ' 減算
End If
' タイマー終了判定
If [テキスト_counter104].Value = 0 Then
[オプション_タイマー96].Value = False
[コンボ_時94] = 0
[コンボ_分98] = 0
[コンボ_秒100] = 0
[テキスト_Tミリ秒141] = 0
Call myHelp_WSH("タイマーが終了しました。", "時間です")
End If
End If
' ストップウォッチ
If [オプション_StpW109] = True Then
If [オプション_高精度157] = True Then
[テキスト_SWCounter120].Value = [テキスト_SWCounter120].Value + [テキスト_処理時間154].Value ' 加算
Else
[テキスト_SWCounter120].Value = [テキスト_SWCounter120].Value + 1 ' カウンタをインクリメント
End If
End If
myFlag1 = 0 ' フラグをリセット
' 2秒カウンタ
[テキスト_counter158] = [テキスト_counter158] + [テキスト_処理時間154]
If [テキスト_counter158] >= 2000 Then
[テキスト_counter158] = 0
If [オプション_高精度157] = True Then
myFlag1 = 1 ' フラグをセット
End If
End If
' 2秒判定（高精度がオフ時）
If ([オプション_高精度157] = False) And ([テキスト_counter92] Mod Int(2000 / TUnit) = 0) Then
myFlag1 = 1 ' フラグをセット
End If
' 日時を一時停止(2000msec間隔)
If ([オプション_日時78].Value = False) And (myFlag1 = 1) Then
' 日時のフォント色を反転
If [テキスト_日時72].ForeColor = RGB(0, 0, 0) Then
[テキスト_日時72].ForeColor = RGB(255, 255, 255) ' White
Else
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
End If
End If
myFlag1 = 0 ' フラグをリセット
' 0.8秒カウンタ
[テキスト_counter160] = [テキスト_counter160] + [テキスト_処理時間154]
If [テキスト_counter160] >= 800 Then
[テキスト_counter160] = 0
If [オプション_高精度157] = True Then
myFlag1 = 1 ' フラグをセット
End If
End If
' 0.8秒判定（高精度がオフ時）
If ([オプション_高精度157] = False) And ([テキスト_counter92] Mod Int(800 / TUnit) = 0) Then
myFlag1 = 1 ' フラグをセット
End If
' 日時を更新(0.8秒間隔)
If ([オプション_日時78].Value = True) And (myFlag1 = 1) Then
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
[テキスト_日時72].Value = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
End If
' タイマーを更新(0.8秒間隔)
If ([オプション_タイマー96].Value = True) And ([テキスト_counter104].Value >= 0) _
And (myFlag1 = 1) Then
[コンボ_時94] = Int([テキスト_counter104].Value / TU_h)
[コンボ_分98] = Int(([テキスト_counter104].Value - [コンボ_時94] * TU_h) / TU_mn)
[コンボ_秒100] = Int(([テキスト_counter104].Value - [コンボ_時94] * TU_h - [コンボ_分98] * TU_mn) / TU_s)
[テキスト_Tミリ秒141] = [テキスト_counter104].Value - [コンボ_時94] * TU_h - [コンボ_分98] * TU_mn _
- [コンボ_秒100] * TU_s
End If
' ストップウォッチを更新(0.8秒間隔)
If ([オプション_StpW109] = True) And (myFlag1 = 1) Then
[コンボ_SW時110] = Int([テキスト_SWCounter120].Value / TU_h)
[コンボ_SW分112] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h) / TU_mn)
[コンボ_SW秒114] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn) / TU_s)
[テキスト_SWm秒140] = [テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn _
- [コンボ_SW秒114] * TU_s
End If
' カウンタが1周(18000msec)したか？
If [テキスト_counter92] = (18000 / [コンボ_単位時間146]) Then
[テキスト_counter92] = 0
End If
End Sub
Private Sub myYear1_LostFocus()
'【変数】
Dim myString1 As String ' 文字列
Dim ANS As Integer ' 答え
'【実行コード】
myString1 = [myYear1] & "/" & ([Co_Month1].ListIndex + 1) & "/" & ([Co_myDay1].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日60] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年33] = Format(myString1, "\[ggge""]年""")
Else
ANS = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日60] = "日 [－]"
' 年号を更新
[テキスト_年33] = "[???]年"
End If
End Sub
Private Sub コマンド_SWLap118_Click()
'【機能】ストップウォッチのLAP/SPLIT
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
Dim SWCounter As Single ' ストップウォッチのカウンター
'【実行コード】
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' ストップウォッチのカウンター値を取り込み
SWCounter = [テキスト_SWCounter120]
'ラップタイムを計算
[テキスト_SWLapCounter138] = SWCounter - [テキスト_SWSplitCounter128]
[コンボ_SWLap時131] = Int([テキスト_SWLapCounter138].Value / TU_h)
[コンボ_SWLap分133] = Int(([テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h) / TU_mn)
[コンボ_SWLap秒135] = Int(([テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h - [コンボ_SWLap分133] * TU_mn) / TU_s)
[テキスト_SWLapm秒143] = [テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h - [コンボ_SWLap分133] * TU_mn _
- [コンボ_SWLap秒135] * TU_s
' スプリットタイムを計算
[テキスト_SWSplitCounter128] = SWCounter
[コンボ_SwSplit時122] = Int([テキスト_SWSplitCounter128].Value / TU_h)
[コンボSwSplit分124] = Int(([テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h) / TU_mn)
[コンボ_SwSplit秒126] = Int(([テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h - [コンボSwSplit分124] * TU_mn) / TU_s)
[テキスト_SWSplitm秒142] = [テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h - [コンボSwSplit分124] * TU_mn _
- [コンボ_SwSplit秒126] * TU_s
End Sub
Private Sub コマンド_SWStrStp116_Click()
'【機能】ストップウォッチの開始／停止
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
If [オプション_StpW109] = False Then
[オプション_StpW109] = True ' 開始
Else
[オプション_StpW109] = False ' 停止
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
[コンボ_SW時110] = Int([テキスト_SWCounter120].Value / TU_h)
[コンボ_SW分112] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h) / TU_mn)
[コンボ_SW秒114] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn) / TU_s)
[テキスト_SWm秒140] = [テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn _
- [コンボ_SW秒114] * TU_s
End If
End Sub
Private Sub コマンド_SWリセット119_Click()
'【機能】ストップウォッチのリセット
[オプション_StpW109] = False ' 停止
[テキスト_SWCounter120] = 0
[コンボ_SW時110] = 0
[コンボ_SW分112] = 0
[コンボ_SW秒114] = 0
[テキスト_SWm秒140] = 0
' スプリットタイム
[コンボ_SwSplit時122] = 0
[コンボSwSplit分124] = 0
[コンボ_SwSplit秒126] = 0
[テキスト_SWSplitm秒142] = 0
[テキスト_SWSplitCounter128] = 0
' ラップタイム
[コンボ_SWLap時131] = 0
[コンボ_SWLap分133] = 0
[コンボ_SWLap秒135] = 0
[テキスト_SWLapm秒143] = 0
[テキスト_SWLapCounter138] = 0
End Sub
Private Sub コマンド_タイマーリセット107_Click()
[テキスト_counter104] = 0
[コンボ_時94] = 0
[コンボ_分98] = 0
[コンボ_秒100] = 0
[テキスト_Tミリ秒141] = 0
End Sub
Private Sub コマンド_タイマー開始102_Click()
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' ラジオボタンがOFFのとき、以下を実行
If [オプション_タイマー96] = False Then
[テキスト_counter104] = [コンボ_時94] * TU_h + [コンボ_分98] * TU_mn + [コンボ_秒100] * TU_s + [テキスト_Tミリ秒141]
If [テキスト_counter104] >= 1 Then
[オプション_タイマー96] = True
End If
End If
End Sub
Private Sub コマンド_タイマー停止106_Click()
' ラジオボタンがONのとき、以下を実行
If [オプション_タイマー96] = True Then
[オプション_タイマー96] = False
End If
End Sub
Private Sub コマンド_一時停止80_Click()
'タイマ間隔プロパティを2秒(2000ms)に再設定
' Me.TimerInterval = 2000
' ラジオボタンをOFF
[オプション_日時78].Value = False
End Sub
Private Sub コマンド_画面更新150_Click()
If [オプション_画面更新151] = True Then
Application.Echo False, "処理中..." ' 画面更新停止"
[オプション_画面更新151] = False
[テキスト_counter92].Visible = False
[テキスト_counter104].Visible = False
[テキスト_SWCounter120].Visible = False
[テキスト_SWSplitCounter128].Visible = False
[テキスト_SWLapCounter138].Visible = False
[テキスト_処理時間154].Visible = False
[テキスト_counter158].Visible = False
[テキスト_counter160].Visible = False
Else
Application.Echo True ' 画面更新再開
[オプション_画面更新151] = True
[テキスト_counter92].Visible = True
[テキスト_counter104].Visible = True
[テキスト_SWCounter120].Visible = True
[テキスト_SWSplitCounter128].Visible = True
[テキスト_SWLapCounter138].Visible = True
[テキスト_処理時間154].Visible = True
[テキスト_counter158].Visible = True
[テキスト_counter160].Visible = True
End If
End Sub
Private Sub コマンド_開き直し153_Click()
'【機能】フォームを閉じて、再度開く
On Error GoTo ERR1
'【変数】
Dim myID As Long ' ID
Dim myAns As Integer ' 答え
'【実行コード】
DoCmd.Close acForm, "F_時計", acSavePrompt ' フォームを閉じる
myAns = MsgBox("フォームを再度開きますか？", vbOKCancel + vbDefaultButton2)
If myAns = vbOK Then
DoCmd.OpenForm "F_時計", acNormal, , , acFormPropertySettings, acWindowNormal ' フォームを開く
End If
Exit Sub
ERR1:
MsgBox ("エラー(開き直し_Click)" & vbCrLf & Err.Description)
End Sub
Private Sub コマンド_現時刻145_Click()
'【機能】アラームに現時刻を設定
[コンボ_時81] = Hour(Now())
[コンボ_分90] = Minute(Now())
End Sub
Private Sub コマンド_高精度156_Click()
'【機能】高精度モードのON/OFF
If [オプション_高精度157].Value = True Then
[オプション_高精度157].Value = False
Else
[オプション_高精度157].Value = True
End If
End Sub
Private Sub コマンド_日時停止75_Click()
'タイマ間隔プロパティをゼロにする
Me.TimerInterval = 0
' ラジオボタンをOFF
[オプション_日時78].Value = False
' 日時を黒色に
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
' 単位時間をアンロック
[コンボ_単位時間146].Locked = False
End Sub
Private Sub コマンド_日時再開74_Click()
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
' 単位時間
TUnit = [コンボ_単位時間146]
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' MsgBox TUnit & "," & TU_h & "," & TU_mn & "," & TU_s
'タイマ間隔プロパティを0.1秒(100ms) or 1msに再設定
Forms![F_時計].TimerInterval = TUnit
' カウンタ初期化
[テキスト_counter92] = 0
' ラジオボタンをON
[オプション_日時78].Value = True
' 単位時間をロック
[コンボ_単位時間146].Locked = True
End Sub
３．Module1標準モジュールのVBAマクロです。
Option Compare Database
Function UFWeekday1(myDate1 As String)
'【機能】日付を曜日に変換
'【引数】
' myDate1 : 日付(yyyy/mm/dd)
'【変数】
'【実行コード】
Select Case Weekday(myDate1)
Case vbSunday
UFWeekday1 = "日"
Case vbMonday
UFWeekday1 = "月"
Case vbTuesday
UFWeekday1 = "火"
Case vbWednesday
UFWeekday1 = "水"
Case vbThursday
UFWeekday1 = "木"
Case vbFriday
UFWeekday1 = "金"
Case vbSaturday
UFWeekday1 = "土"
End Select
End Function
Sub myHelp_WSH(strText As String, strTitle As String)
'【機能】WSHによるヘルプ
'【変数】
Dim objWshShell
Dim intButton
'【実行コード】
Set objWshShell = CreateObject("WScript.Shell")
' nSecondsToWait=0
' nType : 0[OK]+48[!]
intButton = objWshShell.PopUp(strText, 0, strTitle, 48)
Set objWshShell = Nothing
End Sub
４．mdlStopwatch標準モジュールのVBAマクロです。
Option Compare Database
Option Explicit
Private Declare Function QueryPerformanceCounter Lib "Kernel32" _
(X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" _
(X As Currency) As Boolean
Dim Freq As Currency
Dim Overhead As Currency
Dim Ctr1 As Currency, Ctr2 As Currency, Result As Currency
'ミリ秒以下の高精度で処理時間計測
Public Sub SWStart()
If QueryPerformanceCounter(Ctr1) Then
QueryPerformanceCounter Ctr2
QueryPerformanceFrequency Freq
' Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _
' Freq * 10000; " sec"
' Debug.Print "API Overhead: "; (Ctr2 - Ctr1) / Freq * 1000; "ミリ秒"
Overhead = Ctr2 - Ctr1
Else
Err.Raise 513, "StopwatchError", "High-resolution counter not supported."
End If
QueryPerformanceCounter Ctr1
End Sub
Public Sub SWStop()
QueryPerformanceCounter Ctr2
Result = (Ctr2 - Ctr1 - Overhead) / Freq * 1000
Forms.F_時計.テキスト_処理時間154.Value = Result
End Sub
Public Sub SWShow(Optional Caption As String)
Debug.Print Caption & " " & Result
End Sub
解説は。。。ごめんなさい。![[猫]](https://blog.ss-blog.jp/_images_e/101.gif)
時計のマクロのコードを公開します。
１．まず、フォームの画面イメージです。
２．フォームのVBAマクロです。
Option Compare Database
Private Sub Form_Load()
'【イベント】フォーム読込時
On Error GoTo ERR1
'【変数】
Dim ANS As Integer ' 答え
'【実行コード】
'タイマ間隔プロパティを0.1秒(100ms)に再設定
Me.TimerInterval = 100
[コンボ_単位時間146].Value = 100
' 単位時間をロック
[コンボ_単位時間146].Locked = True
' カウンタ初期化
[テキスト_counter92] = 0
' ラジオボタンをON
[オプション_日時78].Value = True
Me.AllowAdditions = True ' レコード追加許可
Me.AllowEdits = True ' 変更許可
Call SWStart ' 時間計測開始
GoTo CleanUp
ERR1:
ANS = MsgBox("エラー(フォーム読込時)" & vbCrLf & Err.Description, vbCritical, "エラー")
GoTo CleanUp
CleanUp:
[コマンド_日時再開74].SetFocus
End Sub
Private Sub Form_Timer()
'【イベント】タイマー時
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
Dim myFlag1 As Integer ' フラグ
'【実行コード】
Call SWStop ' 時間計測停止
Call SWStart ' 時間計測開始
If [オプション_画面更新151] = False Then
Application.Echo False, "処理中..." ' 画面更新停止
Else
Application.Echo True ' 画面更新再開
End If
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' カウンタ92をインクリメント
[テキスト_counter92] = [テキスト_counter92] + 1
' 1/10/100msec間隔
' アラーム確認
If ([オプション_日時78].Value = True) And ([オプション_アラーム88] = True) _
And (TimeSerial([コンボ_時81], [コンボ_分90], 0) = Time()) Then
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
[テキスト_日時72].Value = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
[オプション_アラーム88] = False ' アラームを止める
Call myHelp_WSH([コンボ_時81] & "時" & [コンボ_分90] & "分になりました。", "時間です")
End If
' タイマー
If ([オプション_タイマー96].Value = True) And ([テキスト_counter104].Value >= 0) Then
If [オプション_高精度157] = True Then
[テキスト_counter104].Value = [テキスト_counter104].Value - [テキスト_処理時間154].Value ' 減算
If [テキスト_counter104].Value < 0 Then
[テキスト_counter104].Value = 0
End If
Else
[テキスト_counter104].Value = [テキスト_counter104].Value - 1 ' 減算
End If
' タイマー終了判定
If [テキスト_counter104].Value = 0 Then
[オプション_タイマー96].Value = False
[コンボ_時94] = 0
[コンボ_分98] = 0
[コンボ_秒100] = 0
[テキスト_Tミリ秒141] = 0
Call myHelp_WSH("タイマーが終了しました。", "時間です")
End If
End If
' ストップウォッチ
If [オプション_StpW109] = True Then
If [オプション_高精度157] = True Then
[テキスト_SWCounter120].Value = [テキスト_SWCounter120].Value + [テキスト_処理時間154].Value ' 加算
Else
[テキスト_SWCounter120].Value = [テキスト_SWCounter120].Value + 1 ' カウンタをインクリメント
End If
End If
myFlag1 = 0 ' フラグをリセット
' 2秒カウンタ
[テキスト_counter158] = [テキスト_counter158] + [テキスト_処理時間154]
If [テキスト_counter158] >= 2000 Then
[テキスト_counter158] = 0
If [オプション_高精度157] = True Then
myFlag1 = 1 ' フラグをセット
End If
End If
' 2秒判定（高精度がオフ時）
If ([オプション_高精度157] = False) And ([テキスト_counter92] Mod Int(2000 / TUnit) = 0) Then
myFlag1 = 1 ' フラグをセット
End If
' 日時を一時停止(2000msec間隔)
If ([オプション_日時78].Value = False) And (myFlag1 = 1) Then
' 日時のフォント色を反転
If [テキスト_日時72].ForeColor = RGB(0, 0, 0) Then
[テキスト_日時72].ForeColor = RGB(255, 255, 255) ' White
Else
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
End If
End If
myFlag1 = 0 ' フラグをリセット
' 0.8秒カウンタ
[テキスト_counter160] = [テキスト_counter160] + [テキスト_処理時間154]
If [テキスト_counter160] >= 800 Then
[テキスト_counter160] = 0
If [オプション_高精度157] = True Then
myFlag1 = 1 ' フラグをセット
End If
End If
' 0.8秒判定（高精度がオフ時）
If ([オプション_高精度157] = False) And ([テキスト_counter92] Mod Int(800 / TUnit) = 0) Then
myFlag1 = 1 ' フラグをセット
End If
' 日時を更新(0.8秒間隔)
If ([オプション_日時78].Value = True) And (myFlag1 = 1) Then
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
[テキスト_日時72].Value = Format(Now(), "yyyy\[ggge""]年""mm\月dd""日[") _
& UFWeekday1(Now()) _
& Format(Now(), "\] hh\:nn\:ss")
End If
' タイマーを更新(0.8秒間隔)
If ([オプション_タイマー96].Value = True) And ([テキスト_counter104].Value >= 0) _
And (myFlag1 = 1) Then
[コンボ_時94] = Int([テキスト_counter104].Value / TU_h)
[コンボ_分98] = Int(([テキスト_counter104].Value - [コンボ_時94] * TU_h) / TU_mn)
[コンボ_秒100] = Int(([テキスト_counter104].Value - [コンボ_時94] * TU_h - [コンボ_分98] * TU_mn) / TU_s)
[テキスト_Tミリ秒141] = [テキスト_counter104].Value - [コンボ_時94] * TU_h - [コンボ_分98] * TU_mn _
- [コンボ_秒100] * TU_s
End If
' ストップウォッチを更新(0.8秒間隔)
If ([オプション_StpW109] = True) And (myFlag1 = 1) Then
[コンボ_SW時110] = Int([テキスト_SWCounter120].Value / TU_h)
[コンボ_SW分112] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h) / TU_mn)
[コンボ_SW秒114] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn) / TU_s)
[テキスト_SWm秒140] = [テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn _
- [コンボ_SW秒114] * TU_s
End If
' カウンタが1周(18000msec)したか？
If [テキスト_counter92] = (18000 / [コンボ_単位時間146]) Then
[テキスト_counter92] = 0
End If
End Sub
Private Sub myYear1_LostFocus()
'【変数】
Dim myString1 As String ' 文字列
Dim ANS As Integer ' 答え
'【実行コード】
myString1 = [myYear1] & "/" & ([Co_Month1].ListIndex + 1) & "/" & ([Co_myDay1].ListIndex + 1)
If IsDate(myString1) Then
'曜日を更新
[テキスト_日60] = "日 [" & UFWeekday1(myString1) & "]"
' 年号を更新
[テキスト_年33] = Format(myString1, "\[ggge""]年""")
Else
ANS = MsgBox("その日付(" & myString1 & ")は存在しません", vbExclamation, "だめよ")
'曜日を更新
[テキスト_日60] = "日 [－]"
' 年号を更新
[テキスト_年33] = "[???]年"
End If
End Sub
Private Sub コマンド_SWLap118_Click()
'【機能】ストップウォッチのLAP/SPLIT
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
Dim SWCounter As Single ' ストップウォッチのカウンター
'【実行コード】
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' ストップウォッチのカウンター値を取り込み
SWCounter = [テキスト_SWCounter120]
'ラップタイムを計算
[テキスト_SWLapCounter138] = SWCounter - [テキスト_SWSplitCounter128]
[コンボ_SWLap時131] = Int([テキスト_SWLapCounter138].Value / TU_h)
[コンボ_SWLap分133] = Int(([テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h) / TU_mn)
[コンボ_SWLap秒135] = Int(([テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h - [コンボ_SWLap分133] * TU_mn) / TU_s)
[テキスト_SWLapm秒143] = [テキスト_SWLapCounter138].Value - [コンボ_SWLap時131] * TU_h - [コンボ_SWLap分133] * TU_mn _
- [コンボ_SWLap秒135] * TU_s
' スプリットタイムを計算
[テキスト_SWSplitCounter128] = SWCounter
[コンボ_SwSplit時122] = Int([テキスト_SWSplitCounter128].Value / TU_h)
[コンボSwSplit分124] = Int(([テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h) / TU_mn)
[コンボ_SwSplit秒126] = Int(([テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h - [コンボSwSplit分124] * TU_mn) / TU_s)
[テキスト_SWSplitm秒142] = [テキスト_SWSplitCounter128].Value - [コンボ_SwSplit時122] * TU_h - [コンボSwSplit分124] * TU_mn _
- [コンボ_SwSplit秒126] * TU_s
End Sub
Private Sub コマンド_SWStrStp116_Click()
'【機能】ストップウォッチの開始／停止
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
If [オプション_StpW109] = False Then
[オプション_StpW109] = True ' 開始
Else
[オプション_StpW109] = False ' 停止
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
[コンボ_SW時110] = Int([テキスト_SWCounter120].Value / TU_h)
[コンボ_SW分112] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h) / TU_mn)
[コンボ_SW秒114] = Int(([テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn) / TU_s)
[テキスト_SWm秒140] = [テキスト_SWCounter120].Value - [コンボ_SW時110] * TU_h - [コンボ_SW分112] * TU_mn _
- [コンボ_SW秒114] * TU_s
End If
End Sub
Private Sub コマンド_SWリセット119_Click()
'【機能】ストップウォッチのリセット
[オプション_StpW109] = False ' 停止
[テキスト_SWCounter120] = 0
[コンボ_SW時110] = 0
[コンボ_SW分112] = 0
[コンボ_SW秒114] = 0
[テキスト_SWm秒140] = 0
' スプリットタイム
[コンボ_SwSplit時122] = 0
[コンボSwSplit分124] = 0
[コンボ_SwSplit秒126] = 0
[テキスト_SWSplitm秒142] = 0
[テキスト_SWSplitCounter128] = 0
' ラップタイム
[コンボ_SWLap時131] = 0
[コンボ_SWLap分133] = 0
[コンボ_SWLap秒135] = 0
[テキスト_SWLapm秒143] = 0
[テキスト_SWLapCounter138] = 0
End Sub
Private Sub コマンド_タイマーリセット107_Click()
[テキスト_counter104] = 0
[コンボ_時94] = 0
[コンボ_分98] = 0
[コンボ_秒100] = 0
[テキスト_Tミリ秒141] = 0
End Sub
Private Sub コマンド_タイマー開始102_Click()
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
' 単位時間
If [オプション_高精度157] = True Then
TUnit = 1 ' 1msec.
Else
TUnit = [コンボ_単位時間146]
End If
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' ラジオボタンがOFFのとき、以下を実行
If [オプション_タイマー96] = False Then
[テキスト_counter104] = [コンボ_時94] * TU_h + [コンボ_分98] * TU_mn + [コンボ_秒100] * TU_s + [テキスト_Tミリ秒141]
If [テキスト_counter104] >= 1 Then
[オプション_タイマー96] = True
End If
End If
End Sub
Private Sub コマンド_タイマー停止106_Click()
' ラジオボタンがONのとき、以下を実行
If [オプション_タイマー96] = True Then
[オプション_タイマー96] = False
End If
End Sub
Private Sub コマンド_一時停止80_Click()
'タイマ間隔プロパティを2秒(2000ms)に再設定
' Me.TimerInterval = 2000
' ラジオボタンをOFF
[オプション_日時78].Value = False
End Sub
Private Sub コマンド_画面更新150_Click()
If [オプション_画面更新151] = True Then
Application.Echo False, "処理中..." ' 画面更新停止"
[オプション_画面更新151] = False
[テキスト_counter92].Visible = False
[テキスト_counter104].Visible = False
[テキスト_SWCounter120].Visible = False
[テキスト_SWSplitCounter128].Visible = False
[テキスト_SWLapCounter138].Visible = False
[テキスト_処理時間154].Visible = False
[テキスト_counter158].Visible = False
[テキスト_counter160].Visible = False
Else
Application.Echo True ' 画面更新再開
[オプション_画面更新151] = True
[テキスト_counter92].Visible = True
[テキスト_counter104].Visible = True
[テキスト_SWCounter120].Visible = True
[テキスト_SWSplitCounter128].Visible = True
[テキスト_SWLapCounter138].Visible = True
[テキスト_処理時間154].Visible = True
[テキスト_counter158].Visible = True
[テキスト_counter160].Visible = True
End If
End Sub
Private Sub コマンド_開き直し153_Click()
'【機能】フォームを閉じて、再度開く
On Error GoTo ERR1
'【変数】
Dim myID As Long ' ID
Dim myAns As Integer ' 答え
'【実行コード】
DoCmd.Close acForm, "F_時計", acSavePrompt ' フォームを閉じる
myAns = MsgBox("フォームを再度開きますか？", vbOKCancel + vbDefaultButton2)
If myAns = vbOK Then
DoCmd.OpenForm "F_時計", acNormal, , , acFormPropertySettings, acWindowNormal ' フォームを開く
End If
Exit Sub
ERR1:
MsgBox ("エラー(開き直し_Click)" & vbCrLf & Err.Description)
End Sub
Private Sub コマンド_現時刻145_Click()
'【機能】アラームに現時刻を設定
[コンボ_時81] = Hour(Now())
[コンボ_分90] = Minute(Now())
End Sub
Private Sub コマンド_高精度156_Click()
'【機能】高精度モードのON/OFF
If [オプション_高精度157].Value = True Then
[オプション_高精度157].Value = False
Else
[オプション_高精度157].Value = True
End If
End Sub
Private Sub コマンド_日時停止75_Click()
'タイマ間隔プロパティをゼロにする
Me.TimerInterval = 0
' ラジオボタンをOFF
[オプション_日時78].Value = False
' 日時を黒色に
[テキスト_日時72].ForeColor = RGB(0, 0, 0) ' Black
' 単位時間をアンロック
[コンボ_単位時間146].Locked = False
End Sub
Private Sub コマンド_日時再開74_Click()
'【変数】
Dim TUnit As Single ' 単位時間
Dim TU_h, TU_mn, TU_s, TU_ml As Single '時、分、秒、ミリ秒の計算に使用する時間
'【実行コード】
' 単位時間
TUnit = [コンボ_単位時間146]
TU_h = 60# * 60# * 1000# / TUnit ' 時
TU_mn = 60# * 1000# / TUnit ' 分
TU_s = 1000# / TUnit ' 秒
' MsgBox TUnit & "," & TU_h & "," & TU_mn & "," & TU_s
'タイマ間隔プロパティを0.1秒(100ms) or 1msに再設定
Forms![F_時計].TimerInterval = TUnit
' カウンタ初期化
[テキスト_counter92] = 0
' ラジオボタンをON
[オプション_日時78].Value = True
' 単位時間をロック
[コンボ_単位時間146].Locked = True
End Sub
３．Module1標準モジュールのVBAマクロです。
Option Compare Database
Function UFWeekday1(myDate1 As String)
'【機能】日付を曜日に変換
'【引数】
' myDate1 : 日付(yyyy/mm/dd)
'【変数】
'【実行コード】
Select Case Weekday(myDate1)
Case vbSunday
UFWeekday1 = "日"
Case vbMonday
UFWeekday1 = "月"
Case vbTuesday
UFWeekday1 = "火"
Case vbWednesday
UFWeekday1 = "水"
Case vbThursday
UFWeekday1 = "木"
Case vbFriday
UFWeekday1 = "金"
Case vbSaturday
UFWeekday1 = "土"
End Select
End Function
Sub myHelp_WSH(strText As String, strTitle As String)
'【機能】WSHによるヘルプ
'【変数】
Dim objWshShell
Dim intButton
'【実行コード】
Set objWshShell = CreateObject("WScript.Shell")
' nSecondsToWait=0
' nType : 0[OK]+48[!]
intButton = objWshShell.PopUp(strText, 0, strTitle, 48)
Set objWshShell = Nothing
End Sub
４．mdlStopwatch標準モジュールのVBAマクロです。
Option Compare Database
Option Explicit
Private Declare Function QueryPerformanceCounter Lib "Kernel32" _
(X As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" _
(X As Currency) As Boolean
Dim Freq As Currency
Dim Overhead As Currency
Dim Ctr1 As Currency, Ctr2 As Currency, Result As Currency
'ミリ秒以下の高精度で処理時間計測
Public Sub SWStart()
If QueryPerformanceCounter(Ctr1) Then
QueryPerformanceCounter Ctr2
QueryPerformanceFrequency Freq
' Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _
' Freq * 10000; " sec"
' Debug.Print "API Overhead: "; (Ctr2 - Ctr1) / Freq * 1000; "ミリ秒"
Overhead = Ctr2 - Ctr1
Else
Err.Raise 513, "StopwatchError", "High-resolution counter not supported."
End If
QueryPerformanceCounter Ctr1
End Sub
Public Sub SWStop()
QueryPerformanceCounter Ctr2
Result = (Ctr2 - Ctr1 - Overhead) / Freq * 1000
Forms.F_時計.テキスト_処理時間154.Value = Result
End Sub
Public Sub SWShow(Optional Caption As String)
Debug.Print Caption & " " & Result
End Sub
解説は。。。ごめんなさい。
ヤバイぜ! ありがとうございます[__猫]
by cheese999 (2018-02-20 04:58)
解説については、おいおい。。[__猫]
by cheese999 (2018-02-20 04:59)