VBAを写経しながらタイピング練習するツールを作成

今回作成したのは、以下のようなツール。
※GIFアニメなので読み込み終わって動き出すまで時間かかるかもしれません。
f:id:t-hom:20170112232253g:plain

サンプルコードが表示され、その通りに入力していくだけのシンプルなものであるが、次に入力すべきキーとそれを押す指の名前が赤く表示される。間違えると入力欄が赤くなる。

経緯

プログラミングを覚えるには、とにかくたくさんコードを手入力することが大切である。
thom.hateblo.jp

ここでキー入力が速いと数をこなすことができるので、上達も早くなる。
しかし最近出会ったとある方はプログラミングをやりたいけれどまだタッチタイプが出来ないという。その方はまだ20代。
若者は皆パソコンを使いこなすと思っていたんだけれど、ひょっとするとスマホの登場でそういう時代はもうとっくに終わったのかもしれない。

昔は一家に一台パソコン、そのあとに一人に一台パソコンの時代（持ってなかった方、ゴメン）と言われていたんだけれど、タッチデバイスの普及によってパソコン初心者は逆に増えているのかもしれない。

でもスマホの普及で逆に万人がアプリ、つまりソフトウェアを日常的に便利に使うようになっているので、自分で作ってみたいという方も増えてくるハズ。

となるとやはりパソコンが使うハメになるわけで、まずはタッチタイプから覚えていくことになる。でもどうせやるならコードを書きながらタッチタイプを覚えたいよね。

というのが作成の経緯。

中身のコード

プロトタイプなので見せられたものではないが、見せてしまおう。
コードはすべてフォームに記載している。この時点で設計としてはよろしくないのだけれど、まぁ今回は適当に。。

フォームのパーツはこんな感じ。
f:id:t-hom:20170112235050p:plain

あれ、キーは？と思われるかもしれないが、キーのラベルは手で配置するのが面倒なのでフォームを起動したときに自動で生成されるようにコードで書いている。

フォームのコードはこんなかんじ。きったなーい。

Private KeyCollection As Collection
Const KeyLabels = "1234567890-^\qwertyuiop@[asdfghjkl;:]zxcvbnm,./\"
Const ShiftLabels = "!""#$%&'()　=~|QWERTYUIOP`{ASDFGHJKL+*}ZXCVBNM<>?_"
Const Fingers = "123344556788812344556788812344556788812344556788"
Const FingerNames = "小指 薬指 中指 人差し指 人差し指 中指 薬指 小指"
Private Sub TextBox1_Change()
    x = Mid(Label1.Caption, Len(TextBox1.Text) + 1, 1)
    Call AssignKey(InStr(1, ShiftLabels, x) > 0)
    
    Dim a: a = InStr(1, KeyLabels, x)
    If a = 0 Then a = InStr(1, ShiftLabels, x)
    lblLeftHand.Caption = ""
    lblRightHand.Caption = ""
    If a <> 0 Then
        Index = CLng(Mid(Fingers, a, 1)) - 1
        cap = Split(FingerNames)(Index)
        If Index >= 4 Then
            lblRightHand.Caption = cap
        Else
            lblLeftHand.Caption = cap
        End If
    End If
        
        
    
    Dim C As MSForms.Control
    For Each C In Me.Controls
        If TypeName(C) = "Label" Then
            If Len(C.Caption) = 1 Then
                C.BackColor = vbWhite
                If C.Caption = x Then
                    C.BackColor = vbRed
                End If
            End If
        End If
    Next
    If TextBox1.Text <> Left(Label1.Caption, Len(TextBox1.Text)) Then
        TextBox1.BackColor = vbRed
    Else
        TextBox1.BackColor = vbWhite
    End If
End Sub

Private Sub UserForm_Initialize()
    Set KeyCollection = New Collection
    Call CreateLabels
    Call TextBox1_Change
End Sub

Sub AssignKey(Optional shift As Boolean = False)
    If shift Then
        lblShiftR.BackColor = vbRed
        lblShiftL.BackColor = vbRed
    Else
        lblShiftR.BackColor = vbWhite
        lblShiftL.BackColor = vbWhite
    End If
    Dim str: str = IIf(shift, ShiftLabels, KeyLabels)
    For i = 1 To KeyCollection.Count
        KeyCollection(i).Caption = Mid(str, i, 1)
    Next
End Sub

Sub KeyActivate(C As String)
    Dim loc As Variant
    loc = InStr(1, KeyLabels, C, vbBinaryCompare)
    KeyCollection(loc).BackColor = vbRed
End Sub

Sub CreateLabels()
    OffsetY = 10
    OffsetX = 10
    
    arr = Array(12, 11, 11, 10)
    Dim L As MSForms.Label
    Dim C As MSForms.Control
    For j = 0 To 3
        For i = 0 To arr(j)
            Set L = Me.Controls.Add("Forms.Label.1")
            Set C = L
            L.Font.Size = 30
            L.BackColor = vbWhite
            L.TextAlign = fmTextAlignCenter
            C.Width = 30
            C.Height = 30
            C.Top = j * (C.Height + 5) + OffsetY
            C.Left = i * (C.Width + 5) + OffsetX
            KeyCollection.Add C
        Next
        OffsetX = OffsetX + (C.Width \ 2)
    Next
    Set L = Me.Controls.Add("Forms.Label.1")
    Set C = L
    L.Font.Size = 30
    L.BackColor = vbWhite
    L.TextAlign = fmTextAlignCenter
    L.Caption = " "
    C.Width = 100
    C.Height = 30
    C.Top = j * (C.Height + 5) + OffsetY
    C.Left = 3 * (35) + OffsetX
    
End Sub