えでゅっけ > とっても Excel > excel 間違い探し VBAマクロ

excel 間違い探し VBAマクロ

概観イメージ

印刷イメージ外観 単語の場合の外観一部
大きさや間違いの数文字などを変えられます。

どこに答えがあるかは今のところ表示しません。

実行の仕方はAlt-F11から VBEditorを開き 再生ボタン(右向き三角)を押して、 実行してください。


ソース

マクロダウンロード

ソース
Dim changeNum As Integer
Dim ch As String, rch As String
Dim xmax As Integer, ymax As Integer
Dim firstX As Integer, firstY As Integer
Const printWidth = 70
Const printHeight = 720

Private loopCheckInAfterStringBox As Variant

Private Sub AfterStringComboBox_Change()
    BeforeStringComboBox.ListIndex = AfterStringComboBox.ListIndex
End Sub

Private Sub BeforeStringComboBox_Change()
    'Dim l As Variant
    lic = BeforeStringComboBox.ListIndex
    If l <> loopCheckInAfterStringBox Then
        AfterStringComboBox.ListIndex = lic
        loopCheckInAfterStringBox = lic
    End If
End Sub

Private Sub makeButton_Click()
    ErrorWord
End Sub


Private Sub ErrorWord()

    Call setParameter
    Call makeArray
    Call setFrameAttr

End Sub


Private Sub setParameter()
    Dim i As Integer

    i = 10
    On Error Resume Next
    i = CInt(SizeXComboBox.Value)
    xmax = i
    i = CInt(SizeYComboBox.Value)
    ymax = i

    i = 1
    If RandomButton.Value Then
        i = Int(Rnd() * 7)
    Else
        On Error Resume Next
        i = CInt(ErrorNumComboBox.Value) - 1
    End If
    changeNum = i


    ch = BeforeStringComboBox.Value
    rch = AfterStringComboBox.Value
    'rch = Str(AfterStringComboBox.List(AfterStringComboBox.ListIndex))

    'ch = "a"

    If doRefleshScreenCheckBox.Value Then
        'Range("A1:Z30").ClearContents
        Range("A1:CZ60").Clear
    End If
    doRefleshScreenCheckBox.Value = False

End Sub

Private Sub makeArray()

    Dim x As Integer, y As Integer, k As Integer

    For i = 0 To xmax - 1
        For j = 0 To ymax - 1
            Cells(firstY + j, firstX + i).Value = ch
            'Str(i) & Str(j) & ch
        Next j
    Next i

    k = 0
    For i = 0 To changeNum
        x = Int(Rnd() * xmax) ' + 1
        y = Int(Rnd() * ymax) ' + 1

        If Cells(firstY + y, firstX + x) = rch Then
            i = i - 1
            k = k + 1
            If k > changeNum * 10 Then
                i = changeNum * 2
            End If
        Else
            With Cells(firstY + y, firstX + x)
             .Value = rch
             '.Font.ColorIndex = 3
            End With
        End If
    Next i




End Sub

Private Sub setFrameAttr()
    With Range(Cells(firstY, firstX), Cells(firstY + ymax - 1, firstX + xmax - 1))
        .ColumnWidth = Int(printWidth / xmax)
        .RowHeight = Int(printHeight / ymax)
        .Borders.LineStyle = xlContinuous
        '.Font.Bold = True
        '.Font.Size = 24
        .HorizontalAlignment = xlHAlignCenter
        .VerticalAlignment = xlVAlignCenter
        '.ShrinkToFit = True
    End With

    Cells(firstX + xmax, firstY).Activate
End Sub



Private Sub StopButton_Click()
    ErrorWordPropertyForm.Hide
End Sub

Private Sub UserForm_Initialize()
    'Dim a(6) As Integer
    Dim a As Variant

    Dim s As String
    Dim i1 As Integer, i2 As Integer
    Dim si As Integer

    a = Array(5, 10, 12, 15, 20, 25, 30)
    firstX = 1
    firstY = 1
    si = 1

    With SizeXComboBox
        For i = 0 To 6
            .AddItem (Str(a(i)))
        Next i
        .ListIndex = si
    End With

    With SizeYComboBox
        For i = 0 To 6
        'For Each i In a
            .AddItem (Str(a(i)))
        Next
        .ListIndex = si
    End With

    a = Array(1, 2, 3, 5, 7, 10)
    si = 0

    With ErrorNumComboBox
        For i = 0 To 5
            .AddItem (Str(a(i)))
        Next i
        .ListIndex = si
    End With

    s = "xoへく右左凸凹赤米梅海"
    i1 = 0
    i2 = 1
    If Int(Rnd() * 100) > 50 Then
        i1 = 1
        i2 = 0
    End If

    si = Int(Rnd() * 6)

    With BeforeStringComboBox
        For i = 0 To 5
            .AddItem (Mid(s, i * 2 + i1 + 1, 1))
        Next i

        .AddItem ("form")
        '.AddItem ("")
        .ListIndex = si
    End With

    With AfterStringComboBox
        For i = 0 To 5
            .AddItem (Mid(s, i * 2 + i2 + 1, 1))
        Next i

        .AddItem ("from")
        '.AddItem ("")
        .ListIndex = si
    End With


End Sub


このページトップへ


えでゅっけ > とっても Excel > excel 間違い探し VBAマクロ