Sub チェック()<br /> Dim i As Long 'カウンタ変数 ※→「開発」→「マクロ」→「Module1」→「ツール」→「マクロ」→「チェック」→「編集」<br /> Dim myTemporary As Long 'あまりの処理<br /> Dim myAmari As Long<br /> Dim myGANS As Long 'Counter Good Answer<br /> Dim SRT_BS As Long 'Displacement Count Area<br /> Dim ST_PTR As Long '生徒のラインナンバー<br /> Dim myANSWR As Boolean '割り算の商と余りが両方あってなければいけない<br /> ' Code<br /> myGANS = 0 'Initialize<br /> myANSWR = False<br /> Sheets("Sheet1").Select 'Select Sheet1<br /> myOperator = Cells(1, 10).Value<br /> <br /> For i = ORG_CLM To DST_CLM<br /> 'A列の値とC列の値の和がE列に入力された答えと正しいか判定<br /> If myOperator = "+" Then<br /> SRT_BS = 5<br /> If Cells(i, NUM1_RW).Value + Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then<br /> Cells(i, ANSW_RW).Font.Color = vbBlue '正解なら文字色を青に<br /> myGANS = myGANS + 1<br /> Else<br /> Cells(i, ANSW_RW).Font.Color = vbRed '不正解なら文字色を赤に<br /> End If<br /> End If<br /> If myOperator = "-" Then<br /> SRT_BS = 10<br /> If Cells(i, NUM1_RW).Value - Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then<br /> Cells(i, ANSW_RW).Font.Color = vbBlue '正解なら文字色を青に<br /> myGANS = myGANS + 1<br /> Else<br /> Cells(i, ANSW_RW).Font.Color = vbRed '不正解なら文字色を赤に<br /> End If<br /> End If<br /> If myOperator = "*" Then<br /> SRT_BS = 15<br /> If Cells(i, NUM1_RW).Value * Cells(i, NUM2_RW).Value = Cells(i, ANSW_RW).Value Then<br /> Cells(i, ANSW_RW).Font.Color = vbBlue '正解なら文字色を青に<br /> myGANS = myGANS + 1<br /> Else<br /> Cells(i, ANSW_RW).Font.Color = vbRed '不正解なら文字色を赤に<br /> End If<br /> End If<br /> If myOperator = "/" Then<br /> SRT_BS = 20<br /> If Int(Cells(i, NUM1_RW).Value / Cells(i, NUM2_RW).Value) = Cells(i, ANSW_RW).Value Then<br /> Cells(i, ANSW_RW).Font.Color = vbBlue '正解なら文字色を青に<br /> myANSWR = True<br /> <br /> Else<br /> Cells(i, ANSW_RW).Font.Color = vbRed '不正解なら文字色を赤に<br /> <br /> End If<br /> myTemporary = Int(Cells(i, NUM1_RW).Value / Cells(i, NUM2_RW).Value)<br /> myAmari = Cells(i, NUM1_RW).Value - myTemporary * Cells(i, NUM2_RW).Value<br /> If Cells(i, AMAR_RW).Value = myAmari Then<br /> Cells(i, AMAR_RW).Font.Color = vbBlue<br /> If myANSWR = True Then<br /> myGANS = myGANS + 1<br /> End If<br /> Else<br /> Cells(i, AMAR_RW).Font.Color = vbRed<br /> End If<br /> End If<br /> Next i<br /> If myGANS = SEIKAI_SU Then<br /> MsgBox "全問正解です。おめでとう!"<br /> Else<br /> MsgBox "もうちょっと!"<br /> End If<br /> <br /> SRT_RW = Cells(1, 13).Value 'Bias Locate depend on 横 operator<br /> Sheets("Sheet2").Select<br /> SRT_BS = SRT_BS + SRT_RW 'Fix Count Location<br /> ST_PTR = Cells(1, 14).Value 'Current 生徒の行<br /> Cells(1, 15).Value = SRT_BS '横のLocation<br /> Cells(ST_PTR, SRT_BS) = myGANS '正解数を入れる<br /> Sheets("Sheet1").Select 'Change Manage Page To Question Page<br />End Sub<br /><br />Sub リセット()<br /> Dim i As Long 'カウンタ変数<br /> Dim myTemporary As Long<br /> UserForm3.Show 'Show List2<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> If IsNumeric(Cells(1, 11).Value) Then<br /> ' MsgBox "True"<br /> If Cells(1, 11).Value = 0 Then<br /> ST_NUM = 4<br /> Cells(1, 11).Value = ST_NUM<br /> Else<br /> ST_NUM = Cells(1, 11).Value '前回からの登録簿のスタート値を使用<br /> 'MsgBox ST_NUM<br /> End If<br /> Else<br /> ST_NUM = 4 '生徒ライン番号初期化<br /> Cells(1, 11).Value = ST_NUM '生徒ライン番号初期化<br /> MsgBox ST_NUM 'for debug<br /> End If<br /> If MsgBox("追加登録しますか?", vbYesNo) = vbYes Then '追加登録をするか?<br /> Do While Cells(1, 12).Value <> "End" '後でENDをセットするルーチンを作る事<br /> If Cells(1, 12).Value = "End" Then '登録作業エンド<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> End If<br /> Cells(1, 10).Value = "Error" 'Error Flag On?<br /> Do While Cells(1, 10).Value = "Error"<br /> FRM_USER.Show 'User Form Show Registry ID<br /> Loop<br /> Cells(1, 10).ClearContents 'Error Flag On?<br /> Loop 'New Loop End<br /> Else<br /> MsgBox "今回は登録しません。"<br /> Sheets("Sheet2").Select<br /> Cells(1, 12).Value = "End"<br /> End If<br /> '問題出題<br /> Sheets("Sheet2").Select 'Servey Loop End<br /> If Cells(1, 12).Value = "End" Then<br /> Cells(1, 12).ClearContents 'For debug<br /> Sheets("Sheet1").Select 'Select Sheet1<br /> UserForm1.Show 'UserForm1 Show 加減乗除<br /> UserForm2.Show '桁数セット<br /> End If<br /> Sheets("Sheet1").Select 'Select Sheet1<br /> myBias = Cells(1, 11).Value 'WorkCell for Bias Value<br /> myOperator = Cells(1, 10).Value 'Workarea for Operator<br /> <br /> For i = ORG_CLM To DST_CLM<br /> Cells(i, ANSW_RW).ClearContents '値をクリア<br /> Cells(i, AMAR_RW).ClearContents<br /> Cells(i, ANSW_RW).Font.Color = vbBlack '文字色を黒に<br /> Cells(i, AMAR_RW).Font.Color = vbBlack<br /> Cells(i, NUM1_RW).Value = Int(Rnd * myBias) 'A列に1桁~4桁のランダムな数値を入力<br /> Cells(i, OPR_RW).Value = myOperator '四則演算子を入れる<br /> Cells(i, NUM2_RW).Value = Int(Rnd * myBias) 'A列に1桁~4桁のランダムな数値を入力<br /> If myOperator = "-" Then<br /> myTemporary = Cells(i, NUM1_RW)<br /> If Cells(i, NUM1_RW) < Cells(i, NUM2_RW) Then<br /> Cells(i, NUM1_RW) = Cells(i, NUM2_RW)<br /> Cells(i, NUM2_RW) = myTemporary<br /> End If<br /> End If<br /> If myOperator = "/" Then<br /> myTemporary = Cells(i, NUM1_RW)<br /> If Cells(i, NUM1_RW) < Cells(i, NUM2_RW) Then<br /> Cells(i, NUM1_RW) = Cells(i, NUM2_RW)<br /> Cells(i, NUM2_RW) = myTemporary<br /> If Cells(i, NUM2_RW) = 0 Then 'Escape 0 devide<br /> Cells(i, NUM2_RW) = 1<br /> End If<br /> Else<br /> If Cells(i, NUM2_RW) = 0 Then 'Escape 0 devide<br /> Cells(i, NUM2_RW) = 1<br /> End If<br /> End If<br /> End If<br /> Next i<br />End Sub<br /><br />Option Explicit<br />Dim strMSG As String<br />Public ST_NUM As Long<br />Private Sub TextBox2_Change()<br />MsgBox "Box2"<br />Unload Me<br />End Sub<br /><br />Private Sub TextBox3_Change()<br />MsgBox "Box3"<br />Unload Me<br />End Sub<br /><br />Private Sub FRM_USER()<br /> MsgBox "FRM_USER()"<br /> Unload Me<br />End Sub<br />Private Sub CMD_OK_Click() 'UserForm_Click()<br /> 'MsgBox "Execute _Click() on Registry"<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> If OptionButton1.Value = True Then '登録終了<br /> Cells(1, 12).Value = "End"<br /> End If<br /> If OptionButton2.Value = True Then<br /> Cells(1, 12).ClearContents<br /> End If<br /> If OptionButton3.Value = True Then<br /> Cells(1, 13).Value = "指定" 'Fix Row<br /> End If<br /> '入力内容のチェック<br /> If Trim$(TXT_NAME.Text) = "" Then<br /> strMSG = "氏名が入力されていません。"<br /> ElseIf Trim$(TXT_CODE.Text) = "" Then<br /> strMSG = "生徒Noが入力されていません。"<br /> ElseIf Trim$(TXT_SCLNM.Text) = "" Then<br /> strMSG = "学校名が入力されていません。"<br /> ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then<br /> strMSG = "生徒Noが数字ではありません。"<br /> ElseIf Len(Trim$(TXT_CODE.Text)) <> 5 Then<br /> strMSG = "生徒Noは5桁で入力してください。"<br /> ElseIf Trim$(TXT_CODE.Text) < 10000 Then<br /> strMSG = "生徒Noは10000以上で入力してください。"<br /> End If<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> If Trim$(strMSG) <> "" Then<br /> Cells(1, 10).Value = "Error" 'Set Error Flag<br /> MsgBox strMSG<br /> Else<br /> Cells(1, 10).ClearContents 'Clear Error Flag<br /> ST_NUM = Cells(1, 11).Value '生徒の番号をセット<br /> <br /> Cells(ST_NUM, 1).Value = Trim$(TXT_NAME.Text) '氏名<br /> Cells(ST_NUM, 2).Value = Trim$(TXT_CODE.Text) '生徒No<br /> Cells(ST_NUM, 3).Value = Trim$(TXT_SCLNM.Text) '学校名<br /> ST_NUM = ST_NUM + 1 'Sheet2の行No<br /> Cells(1, 11).Value = ST_NUM 'Save 生徒No<br /> End If<br /> Unload Me<br />End Sub<br />Option Explicit<br /><br />Private Sub CommandButton1_Click()<br /> ListBox1.RowSource = "Sheet2!A4:A103" 'Set List<br /> 'Unload Me<br />End Sub<br />Private Sub ListBox1_Click()<br /> 'MsgBox Cells(ListBox1.ListIndex + 1, 1) 'Display ST_NUM 生徒No<br /> 'MsgBox ListBox1.ListIndex 'Line No. ST_PTR - 4<br /> Sheets("Sheet2").Select<br /> Cells(1, 14).Value = ListBox1.ListIndex + 4<br /> 'MsgBox ListBox1.ListIndex + 4 'Line NO. ST_PTR<br />End Sub<br /><br />Option Explicit<br />Dim strMSG As String<br />Public ST_NUM As Long<br />Private Sub TextBox2_Change()<br />MsgBox "Box2"<br />Unload Me<br />End Sub<br /><br />Private Sub TextBox3_Change()<br />MsgBox "Box3"<br />Unload Me<br />End Sub<br /><br />Private Sub FRM_USER()<br /> MsgBox "FRM_USER()"<br /> Unload Me<br />End Sub<br />Private Sub CMD_OK_Click() 'UserForm_Click()<br /> 'MsgBox "Execute _Click() on Registry"<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> If OptionButton1.Value = True Then '登録終了<br /> Cells(1, 12).Value = "End"<br /> End If<br /> If OptionButton2.Value = True Then<br /> Cells(1, 12).ClearContents<br /> End If<br /> If OptionButton3.Value = True Then<br /> Cells(1, 13).Value = "指定" 'Fix Row<br /> End If<br /> '入力内容のチェック<br /> If Trim$(TXT_NAME.Text) = "" Then<br /> strMSG = "氏名が入力されていません。"<br /> ElseIf Trim$(TXT_CODE.Text) = "" Then<br /> strMSG = "生徒Noが入力されていません。"<br /> ElseIf Trim$(TXT_SCLNM.Text) = "" Then<br /> strMSG = "学校名が入力されていません。"<br /> ElseIf IsNumeric(Trim$(TXT_CODE.Text)) <> True Then<br /> strMSG = "生徒Noが数字ではありません。"<br /> ElseIf Len(Trim$(TXT_CODE.Text)) <> 5 Then<br /> strMSG = "生徒Noは5桁で入力してください。"<br /> ElseIf Trim$(TXT_CODE.Text) < 10000 Then<br /> strMSG = "生徒Noは10000以上で入力してください。"<br /> End If<br /> Sheets("Sheet2").Select 'Select Sheet2<br /> If Trim$(strMSG) <> "" Then<br /> Cells(1, 10).Value = "Error" 'Set Error Flag<br /> MsgBox strMSG<br /> Else<br /> Cells(1, 10).ClearContents 'Clear Error Flag<br /> ST_NUM = Cells(1, 11).Value '生徒の番号をセット<br /> <br /> Cells(ST_NUM, 1).Value = Trim$(TXT_NAME.Text) '氏名<br /> Cells(ST_NUM, 2).Value = Trim$(TXT_CODE.Text) '生徒No<br /> Cells(ST_NUM, 3).Value = Trim$(TXT_SCLNM.Text) '学校名<br /> ST_NUM = ST_NUM + 1 'Sheet2の行No<br /> Cells(1, 11).Value = ST_NUM 'Save 生徒No<br /> End If<br /> Unload Me<br />End Sub<br /><br />Option Explicit<br />Public myOperator As String<br />Const OPR_RW As Integer = 2<br /><br /><br />Private Sub CommandButton1_Click() 'UserForm_Click()<br /> Sheets("Sheet1").Select 'Select Sheet1<br /> If OptionButton1.Value = True Then<br /> myOperator = "+"<br /> End If<br /> If OptionButton2.Value = True Then<br /> myOperator = "-"<br /> End If<br /> If OptionButton3.Value = True Then<br /> myOperator = "*"<br /> End If<br /> If OptionButton4.Value = True Then<br /> myOperator = "/"<br /> End If<br /> 'MsgBox myOperator<br /> Cells(1, 10).Value = myOperator 'Save Operator as String<br /> Unload Me<br />End Sub<br /><br />'Private Sub UserForm_Click()<br />' 'UserForm.Show<br />' MsgBox "Before CommandButton1"<br />'End Sub<br />Private Sub UserForm_Click()<br /><br />End Sub<br /><br /><br />Option Explicit<br />Public myBias As Long<br />Public SRT_RW As Long<br />Private Sub CommandButton1_Click() 'UserForm_Click()<br /> Sheets("Sheet1").Select 'Select Sheet1<br /> SRT_RW = 0 'Initialize Operator Bias Location<br /> 'MsgBox "Before CommandButton1"<br /> If OptionButton1.Value = True Then '1桁<br /> myBias = 10<br /> SRT_RW = SRT_RW + 0<br /> End If<br /> If OptionButton2.Value = True Then '2桁<br /> myBias = 100<br /> SRT_RW = SRT_RW + 1<br /> End If<br /> If OptionButton3.Value = True Then '3桁<br /> myBias = 1000<br /> SRT_RW = SRT_RW + 2<br /> End If<br /> If OptionButton4.Value = True Then '4桁<br /> myBias = 10000<br /> SRT_RW = SRT_RW + 3<br /> End If<br /> 'MsgBox myBias<br /> Cells(1, 11).Value = myBias 'Save 桁数<br /> Cells(1, 13).Value = SRT_RW<br /> Unload Me<br />End Sub<br /><br />'Private Sub UserForm_Click()<br />' MsgBox "Here is UserForm2"<br /> 'UserForm2.Show<br />'End Sub<br />Private Sub UserForm_Click()<br /><br />End Sub<br />Option Explicit<br /><br />Private Sub CommandButton1_Click()<br /> ListBox1.RowSource = "Sheet2!A4:A103" 'Set List<br /> 'Unload Me<br />End Sub<br />Private Sub ListBox1_Click()<br /> 'MsgBox Cells(ListBox1.ListIndex + 1, 1) 'Display ST_NUM 生徒No<br /> 'MsgBox ListBox1.ListIndex 'Line No. ST_PTR - 4<br /> Sheets("Sheet2").Select<br /> Cells(1, 14).Value = ListBox1.ListIndex + 4<br /> 'MsgBox ListBox1.ListIndex + 4 'Line NO. ST_PTR<br />End Sub
エディター内ではシンタックス・ハイライトしないと指定したのに色付けされている。多分ログオフしたらプレーン表示されるに違いない。GutenbergのBugに違いない!
WP5.3 classic editor WP SyntaxHighlighterに戻してみた。改行が効かずに1行になってしまったがSyntaxHighlightはされている。