' ' ※ シートコピーおよびシート消去(人数設定の必要なもの)は、 ' 必ず C3Jitute.xls を読み込んでから、マクロを始動して下さい。 ' Global CL_BEG(4), CL_END(4), CL_MEM(4) Sub クラス人数計算() ' ' クラス人数計算 ' マクロ記録日 : 1999/3/28 ユーザー名 : H.Miyamoto ' 'Workbooks.Open FileName:="C:\C3Jitute.XLS" Dim K クラス番号順並べ替え Windows("C3Jitute.XLS").Activate Sheets("得点").Select NUMB = 1: S = 0 For K = 1 To 4 CL_BEG(K) = NUMB + 4 GoSub DET CL_END(K) = NUMB + 4 CL_MEM(K) = CL_END(K) - CL_BEG(K) + 1 NUMB = NUMB + 1: S = S + CL_MEM(K) Next ALL = S Exit Sub DET: Do Until Cells(NUMB + 4, 1) <> Cells(NUMB + 5, 1) NUMB = NUMB + 1 Loop Return End Sub Sub クラス番号順並べ替え() ' ' クラス番号順並べ替えマクロ ' マクロ記録日 : 1995/4/17 ユーザー名 : H.Miyamoto ' remake Mar.27 '99 ' ' Dim ALL Windows("C3Jitute.XLS").Activate Sheets("得点").Select '学年人数設定 NU = 1 Do Until Cells(NU + 4, 3) = Cells(4, 3) NU = NU + 1 Loop ALL = NU - 1 Sheets("得点").Select Range(Cells(5, 1), Cells(ALL + 4, 19)).Select Selection.SortSpecial SortMethod:=xlCodePage, key1:=Range("A5"), _ Order1:=xlAscending, key2:=Range("B5"), Order2:=xlAscending, _ Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation _ :=xlTopToBottom Range("A1").Select End Sub Sub シートコピー() ' ' シートコピーマクロ ' マクロ作成日 : 1998/6/25 by H.Miyamoto ' remake '99 May 15 Dim CN クラス人数計算 With Assistant.NewBalloon .Button = msoButtonSetCancel .Heading = "ワークシートを作成します。" .Text = "クラスを選択して下さい。" .Labels(1).Text = "Aクラス" .Labels(2).Text = "Bクラス" .Labels(3).Text = "Cクラス" .Labels(4).Text = "Dクラス" SLabel = .Show End With Select Case SLabel Case 1 Label = "A" CN = 1 Case 2 Label = "B" CN = 2 Case 3 Label = "C" CN = 3 Case 4 Label = "D" CN = 4 End Select Windows("C3.XLS").Activate Sheets("表紙").Select If Label <> "" Then Range("Q37").Select ActiveCell.FormulaR1C1 = Label End If For N = 1 To CL_MEM(CN) 'クラス人数 Sheets("Form").Copy After:=Sheets(1) Sheets("Form (2)").Select Sheets("Form (2)").Name = Str(CL_MEM(CN) + 1 - N) Next End Sub Sub シート消去() ' ' シート消去マクロ ' マクロ作成日 : 1998/6/25 by H.Miyamoto ' ' remake '99 May 18 Dim CN Dim SL As Integer クラス人数計算 With Assistant.NewBalloon .Button = msoButtonSetOkCancel .Heading = "すべてのワークシートを消去します。復活はできません。" .Text = "今までの入力データーも無効になります。本当によろしいですか?" SL = .Show End With If SL = -2 Then End Windows("C3.XLS").Activate Sheets("表紙").Select Lab = Range("Q37") Select Case Lab Case "A" CN = 1 Case "B" CN = 2 Case "C" CN = 3 Case "D" CN = 4 Case Else End End Select Windows("C3.XLS").Activate Application.DisplayAlerts = False For N = 1 To CL_MEM(CN) Sheets(Str(CL_MEM(CN) + 1 - N)).Delete Next Application.DisplayAlerts = True End Sub Sub 通知票印刷() ' ' 通知票印刷 ' マクロ作成日 : 1998/7/21 ユーザー名 : miyamoto ' remake Jun.16 '99 ' Dim St, CLASS, CLS, CL, CLNO Sheets("表紙").Select Label = Range("Q37") Select Case Label Case "A" CN = 1 CLASS = "C3A" Case "B" CN = 2 CLASS = "C3B" Case "C" CN = 3 CLASS = "C3C" Case "D" CN = 4 CLASS = "C3D" End Select クラス人数計算 CL = CL_BEG(CN): CLNO = CL_MEM(CN) For N = 1 To CLNO Windows(CLASS + ".XLS").Activate Sheets(Str(N)).Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next End Sub Sub 表紙印刷() ' ' 表紙印刷 Macro ' マクロ記録日 : 1999/3/18 ユーザー名 : miyamoto ' remake Jun.16 '99 ' Dim St, CLASS, CLS, CL, CLNO Sheets("表紙").Select Label = Range("Q37") Select Case Label Case "A" CN = 1 CLASS = "C3A" Case "B" CN = 2 CLASS = "C3B" Case "C" CN = 3 CLASS = "C3C" Case "D" CN = 4 CLASS = "C3D" End Select クラス人数計算 CL = CL_BEG(CN): CLNO = CL_MEM(CN) For N = CLNO To 1 Step -1 Windows(CLASS + ".XLS").Activate Sheets(Str(N)).Select Range("S1").Select Selection.Copy Sheets("表紙").Select Range("K27").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("S37").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Sheets(Str(N)).Select Range("U1:Y1").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With Sheets("表紙").Select Range("P40:R40").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With Sheets(Str(N)).Select Range("U1").Select Application.CutCopyMode = False Selection.Copy Sheets("表紙").Select Range("P40").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("P40:R40").Select Application.CutCopyMode = False With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With Selection.Merge Sheets(Str(N)).Select Range("U1:Y1").Select Application.CutCopyMode = False With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .ShrinkToFit = False .MergeCells = False End With Selection.Merge Sheets("表紙").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Next End Sub