Dim maxValue As Integer, minValue As Integer
Dim xmax As Integer, ymax As Integer
Dim startX As Integer, startY As Integer
'Dim maxValue As Integer, minValue As Integer
Dim operandIndex As Integer
Dim operands(5) As Variant
Const printWidth = 70
Const printHeight = 600
Private Sub changeOwnOptionButton_Change()
Call changeOwnOptionButton_Click
End Sub
Private Sub changeOwnOptionButton_Click()
maxLabel.Caption = Str(maxScrollBar.Value)
minLabel.Caption = Str(minScrollBar.Value)
minScrollBar.Enabled = changeOwnOptionButton.Value
maxScrollBar.Enabled = changeOwnOptionButton.Value
minScrollBar.Visible = changeOwnOptionButton.Value
maxScrollBar.Visible = changeOwnOptionButton.Value
End Sub
Private Sub doNegativeCheckBox_Click()
If doNegativeCheckBox.Value Then
minLabel.Caption = "-" & maxLabel.Caption
ElseIf changeOwnOptionButton.Value Then
minLabel.Caption = Str(minScrollBar.Value)
Else
minLabel.Caption = "0"
End If
End Sub
Private Sub MakeButton_Click()
Call makeStart
End Sub
Private Sub maxScrollBar_Change()
If maxScrollBar.Value < 0 And Not (doNegativeCheckBox.Value) Then
maxScrollBar.Value = 0
End If
If maxScrollBar.Value < getMinValue Then
minScrollBar.Value = maxScrollBar.Value
minLabel.Caption = Str(minScrollBar.Value)
End If
maxLabel.Caption = Str(maxScrollBar.Value)
End Sub
Private Sub minScrollBar_Change()
If minScrollBar.Value < 0 And Not (doNegativeCheckBox.Value) Then
minScrollBar.Value = 0
End If
If minScrollBar.Value > getMaxValue Then
maxScrollBar.Value = minScrollBar.Value
maxLabel.Caption = Str(maxScrollBar.Value)
End If
minLabel.Caption = Str(minScrollBar.Value)
End Sub
Private Sub onePlaceOptionButton_Click()
maxLabel.Caption = Str(9)
minLabel.Caption = Str(0)
Call doNegativeCheckBox_Click
End Sub
Private Sub operandListBox_Click()
rangeLabel.Caption = "<-(" & operandListBox.Value & ")->"
If operandListBox.ListIndex = 3 Then
doIntegerCheckBox.Visible = True
Else
doIntegerCheckBox.Visible = False
End If
End Sub
Private Sub StopButton_Click()
CalcDoriru.Hide
End Sub
Private Sub TwoPlaceOptionButton_Click()
maxLabel.Caption = Str(99)
minLabel.Caption = Str(0)
Call doNegativeCheckBox_Click
End Sub
Private Sub UserForm_Initialize()
Dim a As Variant
startX = 1
startY = 4
xmax = 2
ymax = 20
a = Array(1, 2, 3, 4, 5, 6)
With xNumComboBox
For i = 0 To 5
.AddItem (Str(a(i)))
Next i
.ListIndex = 1
End With
a = Array(5, 10, 15, 20, 25, 30, 40, 50, 60, 80, 100)
With yNumComboBox
For i = 0 To 10
.AddItem (Str(a(i)))
Next i
.ListIndex = 4
End With
operands(0) = "＋"
operands(1) = "ー"
operands(2) = "×"
operands(3) = "÷"
operands(4) = "@"
With operandListBox
.AddItem ("＋")
.AddItem ("ー")
.AddItem ("×")
.AddItem ("÷")
'.AddItem ("*")
'.AddItem ("/")
.AddItem ("Random")
.ListIndex = 0
End With
onePlaceOptionButton.Value = True
TwoPlaceOptionButton.Value = False
changeOwnOptionButton.Value = False
Call changeOwnOptionButton_Click
Call onePlaceOptionButton_Click
End Sub
Private Sub makeStart()
Call init
Call setProblem
Call setAttr
Call printHeader
'Call printFooter
End Sub
Private Sub init()
Call setParameters
'If doRefleshScreenCheckBox.Value Then
'Range("A1:Z30").ClearContents
Range("A1:CZ100").Clear
'End If
End Sub
Private Sub setParameters()
Dim t As Integer
On Error Resume Next
t = xmax
t = CInt(xNumComboBox.Value)
xmax = t
t = ymax
t = CInt(yNumComboBox.Value)
ymax = t
operandIndex = operandListBox.ListIndex
'MsgBox (Str(operandIndex))
'operand = operandListBox.Value
If operandIndex > 3 Or operandIndex < 0 Then
'operand = ""
operandIndex = 4
End If
maxValue = 10
maxValue = getMaxValue
minValue = 0
minValue = getMinValue
End Sub
Private Sub setProblem()
Dim i As Integer, j As Integer, v As Integer, oi As Integer
Dim flg As Boolean, flg_i As Boolean
Dim tv As Integer
flg_po = Not (doNegativeCheckBox.Value)
flg_i = doIntegerCheckBox.Value
oi = operandIndex
'MsgBox (Str(operandIndex))
For i = 0 To xmax - 1
For j = 0 To ymax - 1
v1 = Int(Rnd() * (maxValue - minValue)) + minValue
v2 = Int(Rnd() * (maxValue - minValue)) + minValue
v = j + 1 + i * ymax
If operandIndex > 3 Then
oi = Int(Rnd() * 4)
End If
If oi = 1 And flg_po Then
v1 = v1 + v2
ElseIf oi = 3 Then
If flg_i Then
v1 = v1 * v2
ElseIf flg_po And v1 < v2 Then
tv = v1
v1 = v2
v2 = tv
End If
If v2 = 0 Then
v2 = 0
End If
End If
Cells(j + startY, i + startX).Value = Format(v, "(###)") _
& Str(v1) & " " & operands(oi) _
& " " & Str(v2) & " = "
'& Format(v2, " #### = ")
'Cells(i + startX, j + startY).Value = Str(i) & " " & Str(j)
'"(" & Str(v) & "). "
Next j
Next i
End Sub
Private Sub setAttr()
Dim xt As Integer
xt = xmax
'If xt < 2 Then
' xt = 2
'End If
With Range(Cells(startY, startX), _
Cells(startY + ymax - 1, startX + xt - 1))
.ColumnWidth = Int(printWidth / xt)
.RowHeight = Int(printHeight / ymax)
'.Borders.LineStyle = xlContinuous
'.Font.Bold = True
.Font.Size = Int(.RowHeight * 8 / 10)
If LeftAlignCheckBox.Value Then
.HorizontalAlignment = xlHAlignLeft
Else
.HorizontalAlignment = xlHAlignCenter
End If
.VerticalAlignment = xlVAlignCenter
.ShrinkToFit = True
End With
Cells(1, 1).Activate
End Sub
Private Sub printHeader()
Worksheets.Item(1).Name = "計算ドリル"
'ctype = Mid(ARITH_SIGN, CalculateType + 1, 1)
' With Worksheets.Item(2)
' '.Activate
' '.Range("A1:Z30").Clear
' 'Selection.Clear
' .Name = "計算ドリル(解答)"
' With .Range("B1")
' .Value = "100マス計算(解答)"
' .Font.Bold = True
' .Font.Italic = True
' End With
' With .Cells(OffsetX, OffsetY)
' .Value = ctype
' .Font.Bold = True
' .Font.Size = 32
' .HorizontalAlignment = xlHAlignCenter
' .VerticalAlignment = xlVAlignCenter
' End With
' End With
With Range("A1")
.Value = "計算ドリル"
.Font.Bold = True
.Font.Size = 20
End With
With Worksheets.Item(1)
If xmax < 2 Then
.Range("A2").Value = "日付" & Date & Format(Weekday(Date), "(aaaa)") _
& "(時間: 分 秒)"
.Range("A3").Value = "( 回) (名前: )"
Else
.Range("A2").Value = "日付" & Date & Format(Weekday(Date), "(aaaa)")
.Range("B2").Value = "(時間: 分 秒)"
.Range("A3").Value = "( 回)"
.Range("B3").Value = "(名前: )"
.Range("B2:B3").Font.Underline = True
End If
.Range("A2").ShrinkToFit = True
.Range("A2:A3").Font.Underline = True
'.Cells(OffsetX + 11, OffsetY + 1).Value = "コメント（体調など）："
End With
End Sub
Private Function getMaxValue()
If onePlaceOptionButton.Value Then
getMaxValue = 9 + 1
ElseIf TwoPlaceOptionButton.Value Then
getMaxValue = 99 + 1
Else
Dim t As Integer
t = 10
On Error Resume Next
t = CInt(maxScrollBar.Value)
getMaxValue = t
End If
End Function
Private Function getMinValue()
If doNegativeCheckBox.Value Then
getMinValue = 1 - getMaxValue
ElseIf onePlaceOptionButton.Value Then
getMinValue = 0
ElseIf TwoPlaceOptionButton.Value Then
getMinValue = 0
Else
Dim t As Integer
t = 10
On Error Resume Next
t = CInt(minScrollBar.Value) ' - MIN_VALUE
getMinValue = t
End If
End Function
|
