Sub シートコピー() ' ' シートコピー Macro ' マクロ記録日 : 1999/4/6 ユーザー名 : H.Miyamoto ' ' Dim TITLE As String With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "新たなテストシートを作成し、得点シートの点数データをクリアします。" .Text = "処理を続けていいですか?(得点は作成されたテストシートに移ります)" .Labels(1).Text = "続けてちょーだい!" .Labels(2).Text = "お願い、やめて!" SLabel = .Show End With Select Case SLabel Case 1 GoSub GO Case 2 End Case Else End End Select Exit Sub GO: Sheets("得点").Select Selection.Copy Application.CutCopyMode = False Sheets("得点").Copy Before:=Sheets(5) Sheets("得点").Select TITLE = Range("E1") Selection.Copy Sheets("得点 (2)").Select Sheets("得点 (2)").Name = TITLE 得点シートクリア (K) Return End Sub Sub 得点シートクリア(K) ' ' 得点シートクリア Macro ' 2000/3/31 by H.Miyamoto ' ' Dim ALL NU = 1 Do Until Cells(NU + 4, 3) = Cells(4, 3) NU = NU + 1 Loop ALL = NU - 1 Worksheets("得点").Select Range(Cells(5, 22), Cells(ALL + 5, 22)).Select Selection.Copy Range("Z5").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range(Cells(5, 4), Cells(ALL + 5, 25)).Select '個人データクリア Selection.ClearContents Range(Cells(5, 27), Cells(ALL + 5, 27)).Select '比較列クリア Selection.ClearContents Range(Cells(ALL + 7, 4), Cells(ALL + 14, 30)).Select '学年クラスデータクリア Selection.ClearContents Range("E1").Select 'テスト名クリア Selection.ClearContents End Sub Sub 処理名入力() ' ' 処理名入力 ' 1999/4/7 by H.Miyamoto ' ' Sheets("得点").Select With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "学期を選択して下さい" .Text = "クリックしてね!" .Labels(1).Text = "1学期" .Labels(2).Text = "2学期" .Labels(3).Text = "3学期" .Labels(4).Text = "学年成績" SLabel = .Show End With Select Case SLabel Case 1 LabelG = "1学期" Case 2 LabelG = "2学期" Case 3 LabelG = "3学期" Case 4 LabelG = "学年成績" End Select If LabelG <> "学年成績" Then With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "学期を選択して下さい" .Text = "クリックしてね!" .Labels(1).Text = "中間テスト" .Labels(2).Text = "期末テスト" .Labels(3).Text = "成績" SLabel = .Show End With Select Case SLabel Case 1 LabelT = "中間テスト" Case 2 LabelT = "期末テスト" Case 3 LabelT = "成績" End Select Else LabelT = "" End If Range("E1").Select ActiveCell.FormulaR1C1 = "'" + LabelG + LabelT If LabelT = "中間テスト" Or LabelT = "期末テスト" Then Range("V1").Select ActiveCell.FormulaR1C1 = "実施日" Range("W1").Select MON_S = InputBox("開始日の月を入力してください", "(1〜12)") DAY_S = InputBox("開始日を入力してください", "(1〜31)") MON_E = InputBox("終了日の月を入力してください", "(1〜12)") DAY_E = InputBox("終了日を入力してください", "(1〜31)") ActiveCell.FormulaR1C1 = "'" + MON_S + "/" + DAY_S + "〜" + MON_E + "/" + DAY_E Else Range("V1").Select ActiveCell.FormulaR1C1 = "" Range("W1").Select ActiveCell.FormulaR1C1 = "" End If Range("R1").Select End Sub