日本語勉強用ツール―VBAでEXCELの言葉一覧を秒毎にWINDOWS　DESKTOPで表示すること

機能１、「+」を押して、言葉変更頻度１秒追加、「-」を押して、言葉変更頻度１秒減らす
機能２、ENTERを押して、ランダム表示と順序表示切替
※EXCELシートにABC列に別々でに言葉、読み方、意味を記入する。
開始ボタンを追加する。
FROMとTEXTBOXを追加する。

Public Sub kd(keycode As MSForms.ReturnInteger)
 On Error GoTo myError
    If keycode = 107 Then
        If t < 59 Then
            t = t + 1
             UserForm1.TextBox1.value = "間隔" & str(t) & "秒に変更しました。"
        End If
        
    'ENTERキー
    ElseIf keycode = 13 Then
        If zuitiflg Then
            zuitiflg = False
            
            UserForm1.TextBox1.value = "随机解除"
        Else
            '随机
            zuitiflg = True
            UserForm1.TextBox1.value = "随机開始"
        End If
    '"+"キー
    ElseIf keycode = 109 Then
        If t > 1 Then
            t = t - 1
            UserForm1.TextBox1.value = "間隔" & str(t) & "秒に変更しました。"
        End If
    ElseIf keycode = 38 Then
        If j > 1 Then
           UserForm1.TextBox1.value = list(j - 2)
           j = j - 2
        End If
    ElseIf keycode = 40 Then
        If j < UBound(list) - 2 Then
           UserForm1.TextBox1.value = list(j + 2)
           j = j + 2
        End If
    ElseIf keycode = 27 Then
       Application.Quit
    End If
    flg = True
    DoEvents
myError:
End Sub


Option Explicit
Public Declare Function GetForegroundWindow Lib "user32" () As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Const HWND_TOPMOST As Long = -1
Public Const SWP_NOSIZE As Long = &H1&
Public Const SWP_NOMOVE As Long = &H2&
Public t As Integer
Public flg As Boolean
Public zuitiflg As Boolean
Public list() As String
Public j As Integer
'言葉読み
Public Sub readwords()
    UserForm1.TextBox1.Locked = True
    Windows("日本語.xlsm").Activate
    Windows("日本語.xlsm").Visible = True
    Application.ScreenUpdating = False
    Dim value As String
    Range("a1").Activate
    value = ActiveCell.value

    Dim i As Long
    i = 0
    t = 1
    Do Until value = ""

        ReDim Preserve list(i)
        value = ActiveCell.value
        list(i) = value + "  " + ActiveCell.Offset(0, 1) + "  " + ActiveCell.Offset(0, 2)
        ActiveCell.Offset(1, 0).Select
        i = i + 1
    Loop

End Sub

'textに出力
Sub writeTotext()

    Windows("日本語.xlsm").Visible = False
    ThisWorkbook.Application.Visible = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    UserForm1.TextBox1.Font.Size = 12
    On Error GoTo myError
    For j = 0 To UBound(list) - 1
        '出力間隔
        Dim ti As String
        If Len(Trim(str(t))) = 1 Then
            ti = Now + TimeValue("00:00:0" & Trim(str(t)))
        Else
            ti = Now + TimeValue("00:00:" & Trim(str(t)))
        End If
        
        Dim ti2 As String
        flg = False
        Do Until ti2 = ti
            flg = True
            ti2 = Now
        Loop

        If flg Then
            Application.StatusBar = list(j)
            '順序出力
            If zuitiflg = False Then
                UserForm1.TextBox1.value = list(j)
            'ランダム
            Else
                UserForm1.TextBox1.value = list(Rnd * (UBound(list) - 1))
            End If
            DoEvents
            ti2 = Now
        End If
        '最後の場合、前から再開始
        If j = UBound(list) - 1 Then
            writeTotext
        End If
    Next
    
myError:
End Sub


Option Explicit
Option Private Module
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32.dll" ()
Private Declare Function WindowFromAccessibleObject Lib "oleacc.dll" _
        (ByVal IAcessible As Object, ByRef hwnd As Long) As Long
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
  (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Const GWL_STYLE = (-16&)
Const GWL_EXSTYLE = (-20&)
Const WS_CAPTION = &HC00000
Const WS_EX_DLGMODALFRAME = &H1&


 
'kFormNonCaption関数
'ユーザーフォームのタイトルバー非表示
'引数：uf ユーザーフォーム
'      flat True=フラットなウィンドウにする(枠無し)
'戻値：0=失敗 0<>成功 変更前のウィンドウスタイルの値
Function kFormNonCaption(ByVal uf As Object, Optional ByVal flat As Boolean) As Long
    Dim wnd As Long, ih#
    ih = uf.InsideHeight
    WindowFromAccessibleObject uf, wnd
    If flat Then SetWindowLong wnd, GWL_EXSTYLE, GetWindowLong(wnd, GWL_EXSTYLE) And Not WS_EX_DLGMODALFRAME
    kFormNonCaption = SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) And Not WS_CAPTION)
    DrawMenuBar wnd
    uf.Height = uf.Height - uf.InsideHeight + ih - 5
  
    uf.BackColor = &H80000002
  
End Function
 
'FormDrag関数
'ユーザーフォームのタイトルバー以外でドラッグ可能にする
'引数：uf ユーザーフォーム
'      Button MouseMoveイベントのButtonをそのまま渡す
'UserForm や Label などのMouseMoveイベント内から呼び出す
Public Sub FormDrag(ByVal uf As UserForm, ByVal Button As Integer)
    Dim hwnd As Long
    If Button = 1 Then
        WindowFromAccessibleObject uf, hwnd
        ReleaseCapture
        Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
End Sub

Sub UserForm_Activate()
    UserForm1.Show
    writeTotext
End Sub