Private Const MIN_ADJUST = 15000 ' As Integer
'Private Const ARITH_SIGN = "X+-/"
Private Const ARITH_SIGN = "×＋ー÷"
Dim offSetX As Integer, offSetY As Integer
Dim valueType As Integer, CalculateType As Integer, first100Masu As Integer
Dim maxValue As Integer, maxValuePlace As Integer
'Dim OffsetAddress As String
Private Sub set100Masu()
'MsgBox ("set!")
'Worksheets.Item(3).Activate
Call checkDefaultValue
If first100Masu = 0 Then
Worksheets.Item(1).Range("A1:Z30").Clear
Worksheets.Item(2).Range("A1:Z30").Clear
End If
'--------------------------------------
'init array
Dim xa(10) As Integer, ya(10) As Integer
Dim num As Integer, min As Integer, maxM As Integer
Dim num2 As Integer, userMin As Integer
min = 0
minM = -32000
userMin = 0
If doSetMinValueCheckBox.Value Then
userMin = MinValueBar.Value - MIN_ADJUST
End If
'除
If CalculateType = 3 Then
min = 1
End If
If valueType = 2 Or valueType = 1 Then
If valueType = 2 Then
num = 10 ^ maxValuePlace
Else
num = maxValue
End If
num = num - userMin
If CalculateType = 3 Then
For i = 0 To 9
ya(i) = Int(Rnd() * num) + 1 + userMin
xa(i) = Int(Rnd() * num) + userMin ' * ya(i)
Next i
ElseIf CalculateType = 2 And doPlusOnlyRadio.Value Then
'引
num2 = num * 2 / 3
For i = 0 To 9
ya(i) = Int(Rnd() * num2) + userMin
If ya(i) > maxM Then
maxM = ya(i)
End If
Next i
For i = 0 To 9
xa(i) = Int(Rnd() * (num - maxM)) + maxM + userMin
Next i
Else
For i = 0 To 9
xa(i) = Int(Rnd() * num) + userMin
ya(i) = Int(Rnd() * num) + userMin
Next i
End If
Else
For i = 0 To 9
xa(i) = i
ya(i) = i + min
Next i
'change value random
Dim temp, i1, i2 As Integer
num = 30
temp = 0
'xa
For i = 0 To num
i1 = Int(Rnd() * 10)
i2 = Int(Rnd() * 10)
temp = xa(i1)
xa(i1) = xa(i2)
xa(i2) = temp
Next i
'ya
For i = 0 To num
i1 = Int(Rnd() * 10)
i2 = Int(Rnd() * 10)
temp = ya(i1)
ya(i1) = ya(i2)
ya(i2) = temp
Next i
End If
Call printFrame(xa, ya, offSetX, offSetY)
Call setAttrOfFrame(offSetX, offSetY, CalculateType)
End Sub
Private Sub printFrame(xa, ya, offSetX As Integer, offSetY As Integer)
With Worksheets.Item(1) '.Activate
For i = 0 To 9
.Cells(offSetX + i + 1, offSetY + 0).Value = xa(i)
.Cells(offSetX + 0, offSetY + i + 1).Value = ya(i)
'Range(OffsetAddress).Offset(i + 1, 0).Value = xa(i)
'Range(OffsetAddress).Offset(0, i + 1).Value = ya(i)
Next i
End With
'Worksheets.Item(2).Activate
With Worksheets.Item(2)
For i = 0 To 9
.Cells(offSetX + i + 1, offSetY + 0).Value = xa(i)
.Cells(offSetX + 0, offSetY + i + 1).Value = ya(i)
For j = 0 To 9
'k = Call calc(xa(i) , ya(j) , calculateType)
If CalculateType = 0 Then
k = xa(i) * ya(j)
ElseIf CalculateType = 1 Then
k = xa(i) + ya(j)
ElseIf CalculateType = 2 Then
k = xa(i) - ya(j)
ElseIf CalculateType = 3 Then
k = xa(i) / ya(j)
End If
.Cells(offSetX + 1 + i, offSetY + 1 + j).Value = k
Next j
Next i
End With
'Worksheets.Item(1).Activate
End Sub
Private Sub setAttrOfFrame(offSetX, offSetY, CalculateType As Integer)
'MsgBox ("set init")
'first100Masu = 0
If first100Masu = 0 Then
first100Masu = 1
'Selection.Clear
Worksheets.Item(1).Name = "100マス計算"
ctype = Mid(ARITH_SIGN, CalculateType + 1, 1)
With Cells(offSetX, offSetY)
.Value = ctype
.Font.Bold = True
.Font.Size = 32
.HorizontalAlignment = xlHAlignCenter
End With
With Worksheets.Item(2)
'.Activate
'.Range("A1:Z30").Clear
'Selection.Clear
.Name = "100マス計算(解答)"
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("B1")
.Value = "100マス計算"
.Font.Bold = True
.Font.Size = 32
End With
With Worksheets.Item(1)
.Range("H1").Value = "日付"
.Range("I1").Value = Date
.Range("I1").ShrinkToFit = True
.Range("J1").Value = Format(Weekday(Date), "(aaaa)")
.Range("H1:J1").Font.Underline = True
.Range("B2").Value = "( 回)"
.Range("B2").Font.Underline = True
.Range("D2").Value = "(時間: "
.Range("E2").Value = " 分 秒)"
.Range("D2:E2").Font.Underline = True
.Range("H2").Value = "(名前: "
.Range("I2").Value = " )"
.Range("H2:I2").Font.Underline = True
.Cells(offSetX + 11, offSetY + 1).Value = "コメント（体調など）："
End With
'frame
For i = 1 To 2
'Worksheets.Item(i).Activate
With Worksheets.Item(i)
With .Range(.Cells(offSetX, offSetY), .Cells(offSetX + 10, offSetY + 10))
.Borders.LineStyle = xlContinuous
.Font.Bold = True
.Font.Size = 24
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
.ShrinkToFit = True
End With
.Range(.Cells(offSetX + 1, offSetY), .Cells(offSetX + 10, offSetY)).Interior.ColorIndex = 17
.Range(.Cells(offSetX, offSetY + 1), .Cells(offSetX, offSetY + 10)).Interior.ColorIndex = 19
With .Range(.Cells(offSetX, offSetY), .Cells(offSetX + 10, offSetY + 10))
.ColumnWidth = 7
.RowHeight = 42
End With
'.Cells(1, 1).Active
End With
Next i
End If
'first100Masu = 1
'PageSetup.PrintArea = "$A$1:$K$17"
'Range("A1:K17").PrintOut(0,1,1,True,,False,,)
End Sub
Private Sub checkDefaultValue()
'OffsetAddress = "A4"
'x と y が 逆のところがある
offSetX = 4
offSetY = 1
first100Masu = 0
'かけ算 0 足し算 1(,引き算 2)
CalculateType = 0
'足し算の時の桁
maxValuePlace = 2
'掛け算の時の最大数
maxValue = 10
'from form
CalculateType = CalcTypeList.ListIndex
maxValue = CInt(TextBox1.Value)
maxValuePlace = CInt(TextBox2.Value)
valueType = 2
If OptionButton1.Value Then
valueType = 0
ElseIf OptionButton2.Value Then
valueType = 1
End If
'check valid
If maxValuePlace < 1 Then
maxValuePlace = 1
ElseIf maxValuePlace > 4 Then
maxValuePlace = 4
End If
If maxValue < 3 Then
maxValue = 3
ElseIf maxValue > 99999 Then
maxValuePlace = 99999
End If
End Sub
Private Function getMaxValue()
Dim ret As Integer
valueType = 2
ret = 10
If OptionButton2.Value Then
valueType = 0
ret = CInt(TextBox1.Value)
ElseIf OptionButton3.Value Then
valueType = 1
ret = 0
On Error Resume Next
ret = 10 ^ CInt(TextBox2.Value)
End If
getMaxValue = ret
'MsgBox (Str(ret))
End Function
Private Function getMinValue()
Dim ret As Integer
ret = 0
If doSetMinValueCheckBox.Value Then
ret = MinValueBar.Value - MIN_ADJUST
ElseIf OptionButton3.Value Then
ret = 0
End If
getMinValue = ret
End Function
Private Sub doSetMinValueCheckBox_Change()
Call MinValueBar_Change
MinValueBar.Enabled = doSetMinValueCheckBox.Value
End Sub
Private Sub MakeButton_Click()
Call set100Masu
End Sub
Private Sub MakeButton_Enter()
Call set100Masu
End Sub
Private Sub StopButton_Click()
'Stop
HyakuMasuUserForm.Hide
End Sub
Private Sub CalcTypeList_Change()
If CalcTypeList.ListIndex = 2 Then
doPlusOnlyRadio.Visible = True
Else
doPlusOnlyRadio.Visible = False
End If
End Sub
Private Sub OptionButton1_Change()
Dim flg As Boolean
flg = Not OptionButton1.Value
doSetMinValueCheckBox.Enabled = flg
MinValueBar.Enabled = flg And doSetMinValueCheckBox.Value
End Sub
Private Sub OptionButton2_Change()
TextBox1.Enabled = OptionButton2.Value
End Sub
Private Sub OptionButton3_Change()
TextBox2.Enabled = OptionButton3.Value
'TextBox2.Visible
End Sub
Private Sub MinValueBar_Change()
Dim v As Integer, mx As Integer
v = MinValueBar.Value - MIN_ADJUST
mx = getMaxValue()
If v >= mx Then
MinValueBar.Value = mx - 1 + MIN_ADJUST
v = mx - 1
End If
MinValueLabel.Caption = Str(v)
End Sub
Private Sub TextBox2_Change()
Dim k As Integer
k = 0
On Error Resume Next
k = CInt(TextBox2.Value)
If k > 0 & k < 4 Then
Label2.Caption = "1 - " & Str(10 ^ k)
Else
Label2.Caption = "Bad Number(1-3)"
End If
End Sub
Private Sub UserForm_Initialize()
CalcTypeList.Clear
CalcTypeList.AddItem ("掛け算")
CalcTypeList.AddItem ("足し算")
CalcTypeList.AddItem ("引き算(適当)")
CalcTypeList.AddItem ("割り算(できない)")
CalcTypeList.ListIndex = 0
Call TextBox2_Change
Call OptionButton2_Change
Call OptionButton3_Change
Call CalcTypeList_Change
Call doSetMinValueCheckBox_Change
End Sub
|
