質問回答用(タイピングゲームの時間計測用)【ExcelVBA】
標準モジュール側のコード
--------------------------------------------
Option Explicit
Public 時間 As Long
'WindowsAPIの時間をミリ秒単位で取得する機能
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Public Sub sample()
時間 = 0
UserForm1.Show vbModeless
End Sub
ユーザーフォーム側のコード
--------------------------------------------
Option Explicit
Public 問題 As String, 対象文字 As String, 今何文字目 As Long, 列 As Long
Public 開始時間 As Long
Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If StrConv(Chr(KeyCode), vbLowerCase) = 対象文字 Then
今何文字目 = 今何文字目 + 1
Label2.Caption = Mid(問題, 1, 今何文字目 - 1)
対象文字 = Mid(問題, 今何文字目, 1)
Else
MsgBox "違う"
End If
If 今何文字目 > Len(問題) Then
列 = 列 + 1
Call 問題変更
End If
If 列 = 6 Then
MsgBox 時間 & "秒"
Unload UserForm1
End
End If
End Sub
Private Sub UserForm_Activate()
Do
開始時間 = GetTickCount
Do While (GetTickCount - 開始時間) < 1000
DoEvents
Loop
時間 = 時間 + 1
Label3.Caption = 時間 & "秒"
UserForm1.Repaint
Loop
End Sub
Private Sub UserForm_Initialize()
Label3.Caption = 時間 & "秒"
列 = 1
Call 問題変更
End Sub
Public Sub 問題変更()
今何文字目 = 1
問題 = Cells(1, 列).Value
対象文字 = Mid(問題, 今何文字目, 1)
Label1.Caption = 問題
Label2.Caption = ""
End Sub