' ' 全クラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake Apr.-May '98 ' Sub 全クラス印刷() Aクラス印刷 (K) Bクラス印刷 (K) Cクラス印刷 (K) Dクラス印刷 (K) Range("A1").Select Sheets("マクロボタン").Select Range("A1").Select End Sub ' ' クラス別印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake Apr.-May '98 ' Sub クラス別印刷() Dim CLASS CLASS = "" クラス印刷 (CLASS) Sheets("マクロボタン").Select Range("A1").Select End Sub ' ' Aクラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake Apr.-May '98 ' Sub Aクラス印刷(K) Dim CLASS CLASS = "A" クラス印刷 (CLASS) End Sub ' ' Bクラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake Apr.-May '98 ' Sub Bクラス印刷(K) Dim CLASS CLASS = "B" クラス印刷 (CLASS) End Sub ' ' Cクラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake Apr.-May '98 ' Sub Cクラス印刷(K) Dim CLASS CLASS = "C" クラス印刷 (CLASS) End Sub ' ' Dクラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake Apr.-May '98 ' Sub Dクラス印刷(K) Dim CLASS CLASS = "D" クラス印刷 (CLASS) End Sub ' ' クラス印刷 マクロ ' マクロ記録日 : 1996/23/6 ユーザー名 : H.Miyamoto ' remake 6/23 '96 ' remake 6/14 '97 ' remake Apr.-May '98 ' remake Mar.27 '99 Sub クラス印刷(CLASS) Dim CL_BEG(4), CL_END(4), CL_MEM(4), ALL As Integer 文字属性解除 GoSub CLDET Do Until CLASS = "a" Or CLASS = "b" Or CLASS = "c" Or CLASS = "d" Or CLASS = "A" Or CLASS = "B" Or CLASS = "C" Or CLASS = "D" CLASS = InputBox("クラス名を入力してください(A〜D)", "印刷するクラス名の入力") Loop Select Case CLASS Case "A", "a" K = 1 Case "B", "b" K = 2 Case "C", "c" K = 3 Case "D", "d" K = 4 End Select CLASS = "" Sheets("得点").Select Range("A1:AD1,A3:AD4").Select '表題1 Selection.Copy Sheets("WorkSheet 1").Select Range("A1").Select ActiveSheet.Paste Sheets("得点").Select Range(Cells(CL_BEG(K), 1), Cells(CL_END(K), 30)).Select Selection.Copy Sheets("WorkSheet 1").Select Range("A4").Select ActiveSheet.Paste Sheets("得点").Select Range(Cells(ALL + 5, 1), Cells(ALL + 13, 30)).Select '平均点全部 Selection.Copy Sheets("WorkSheet 1").Select Range(Cells(CL_MEM(K) + 4, 1), Cells(CL_MEM(K) + 12, 30)).Select ActiveSheet.Paste Range("A1").Select With ActiveSheet.PageSetup .PrintTitleRows = "$1:$3" .PrintTitleColumns = "" End With With ActiveSheet.PageSetup .PrintArea = Range(Cells(1, 1), Cells(CL_MEM(K) + 12, 30)) .FitToPagesWide = 1 .FitToPagesTall = 1 .LeftHeader = "&""MS 明朝,太字""[校外秘]" .CenterHeader = "&D" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.5) .RightMargin = Application.InchesToPoints(0.5) .TopMargin = Application.InchesToPoints(0.9) .BottomMargin = Application.InchesToPoints(0) .HeaderMargin = Application.InchesToPoints(0.5) .FooterMargin = Application.InchesToPoints(0) .PrintHeadings = False .PrintGridlines = True .PrintNotes = False .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperB4 .FirstPageNumber = xlAutomatic .Order = xlOverThenDown .BlackAndWhite = True .Zoom = False End With Range(Cells(1, 1), Cells(CL_MEM(K) + 12, 30)).Select Selection.PrintOut Copies:=1 Selection.ClearContents Range("A1").Select Exit Sub CLDET: クラス番号順並べ替え Sheets("得点").Select NUMB = 1 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 Return DET: Do Until Cells(NUMB + 4, 1) <> Cells(NUMB + 5, 1) NUMB = NUMB + 1 Loop Return End Sub