VBAでタイピング練習自動化してみた

もうそれ、
練習ちゃうやん( ´∀｀ )

というわけでTwitterに引き続きタイピング練習を自動化してみました。

ちなみにBenesseの日本語（ローマ字）です。
↓これね。

最初は普通にコード組みましたけど、自動Twitterから使ってるクラスモジュールに追加して少ないコードでできるように改良しました。

そう考えると、万が一これ読んでくれている方がいた場合参考にはしにくいかもね。はい、自己満です( ´∀｀ )

ポイントは、次のタイプするキーに対してcopyselectorでコピーした要素に「.next」が付くみたいだったのでそれをチェックして、「.next」が付いてる要素のキーをSendKyesで実行する感じです。

Pythonとかはよく見かけるけどVBAでは検索しても見当たらなかったからやり方が正しいかは疑問。

標準モジュールの方のコードはこんな感じ

Option Explicit
    
    Public myChrome          As New OperationCromeDriver
    Public typeURL           As String
    Public startButtonXPath  As String
    Public startTypeXPath    As String
    Public rngKyes           As Range
    Public CheckKye          As Range
    Public finishCheckCss    As String
    Public finishCheckText   As String
    
    
Sub タイピング練習マクロ()

    Call 初期設定
    
    Call タイピング練習実行
    
End Sub

Sub 初期設定()
    
    Dim wb        As Workbook
    Dim ws        As Worksheet
    
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("タイピング練習")
    Set rngKyes = ws.Range("B13:B41")
    
    typeURL = ws.Range("C3")
    startButtonXPath = ws.Range("C5")
    startTypeXPath = ws.Range("C7")
    finishCheckText = ws.Range("B9")
    finishCheckCss = ws.Range("C9")
    
End Sub


Sub タイピング練習実行()
    With myChrome
        .DriverUrlSet typeURL
        .PushButton startButtonXPath
        .PushButton startTypeXPath
        .Driver.SendKeys .skey.Space
        
        Dim kye As String
        Do
            For Each CheckKye In rngKyes
                kye = .KyeCheck(CheckKye.Next.Value, CheckKye.Value)
                If kye <> "" Then
                    .Driver.SendKeys kye
                    .Driver.Wait 50
                    Exit For
                End If
            Next
        Loop Until .textCheck(finishCheckCss, finishCheckText) = True
        
    End With
    Stop
End Sub

うーん。短くまとまるとたのすぃー( ´∀｀ )

クラスモジュールはこんな感じ.
余計なものも交じってるけど。

Option Explicit

Public Driver    As New Selenium.WebDriver
Public elm       As Selenium.WebElement
Public skey      As New Selenium.Keys
Public key       As New Keys
Public myBy      As New By


'CheomeドライバーをセットしてURLを開く
Sub DriverUrlSet(URL)

    Driver.AddArgument "disable-gpu"             'ウインドウサイズを最大化で開く'
    Driver.AddArgument "start-maximized"         '同上'
    Driver.Start "chrome"
    Driver.Wait 2000
    Driver.Get URL                               'URLのページ開く'
    Driver.Wait 2000

End Sub


'Webページ上に指定のXPathがあるかをチェックする。XPathを取得するまでループ処理をする'
'一定時間経過するとプログラムを終了させる'
Sub XPathCheck(ByVal checkXPath1 As String, Optional checkXPath2 As String = "nothingXPath")
    
    Dim i As Long: i = 0
    Dim Flag As Boolean: Flag = False
    
    Do
        Flag = Driver.IsElementPresent(myBy.XPath(checkXPath1)) Or _
                  Driver.IsElementPresent(myBy.XPath(checkXPath2))
        Driver.Wait 2000
        
        i = i + 1
        If i = 50 Then
            MsgBox "処理が継続できません。終了します。"
            End
        End If
    Loop Until Flag = True

End Sub


'指定したCSS要素をWebページ上から取得した場合に、指定したテキストがあるかをチェックして評価値を返す'
Function textCheck(ByVal CheckTextCss As String, ByVal CheckText As String)
    
    Dim check As Boolean:  check = False
    
    If Driver.FindElementByCss(CheckTextCss).Text = CheckText Then check = True

    textCheck = check

End Function


'Webページ上に指定したCSS要素がある場合に指定したキーの文字列を返す'
Function KyeCheck(ByVal CheckKyeCss As String, ByVal CheckKye As String)

    Dim comKye As String: comKye = ""
    If Driver.IsElementPresent(myBy.Css(CheckKyeCss)) Then comKye = CheckKye
    KyeCheck = comKye
    
End Function


'指定したXPath要素のインプットボックスに指定したテキストを入力する'
Sub TextInput(ByVal InputXPath As String, ByVal InputText As String)

    Set elm = Driver.FindElementByXPath(InputXPath)      '入力ボックスのxPath'
    
    elm.Clear
    elm.Click
    elm.SendKeys InputText                               '入力内容'
    elm.SendKeys skey.Enter
    
    Driver.Wait 1000

End Sub


'指定したXPath要素のボタンをクリックする'
Sub PushButton(ByVal ButtonXPath As String)

    Set elm = Driver.FindElementByXPath(ButtonXPath)      'ボタン要素のXPath'
    
    elm.Click
    Driver.Wait 1000

End Sub

Noteってコードは「'」で囲むと色が変わるみたいやからVBAの場合はコメントの後ろにも「'」を付けてやらないと見にくくなるね。
めんどくさいｗ

今度は点数も表示されるようにしようかな。

もしタイピング練習の点数も評価になる会社があれば最高ですね。

ないやろうけど( ´∀｀ )

ではまた。