'
' 個人票印字 マクロ
' ﾏｸﾛ記録日 : 1996/24/6  ﾕｰｻﾞｰ名 : H.Miyamoto
'  remake  6/24 '96
'  remake  6/14 '97
'  remake  5/2-5 '98
'  remake Mar.27 '99
Sub 個人票印字()
    Dim CLS, St As String   'クラス
    Dim CL_BEG(4), CL_END(4), CL_MEM(4), CL_NO, ALL As Integer

    文字属性解除
    
    GoSub CLDET
    Sheets("WorkSheet 3").Select
    
    クラス番号順並べ替え
    
    K = 0   '行変数１
    Y = 0   '行変数２
    NUM = -1
        
    Sheets("得点").Select
    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)", "印刷開始する生徒のクラス名")
        Select Case CLASS
            Case "A", "a"
                CL_NO = 1
                CLS = "Ａ"
            Case "B", "b"
                CL_NO = 2
                CLS = "Ｂ"
            Case "C", "c"
                CL_NO = 3
                CLS = "Ｃ"
            Case "D", "d"
                CL_NO = 4
                CLS = "Ｄ"
        End Select
            St = "開始"
            GoSub BOX
    Loop
    YS = CL_BEG(CL_NO) + NUM - 1
    Y = YS   '印字開始時のパラメータ
    CLASS = ""
    NUM = -1
    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)", "印刷終了する生徒のクラス名")
        Select Case CLASS
            Case "A", "a"
                CL_NO = 1
                CLS = "Ａ"
            Case "B", "b"
                CL_NO = 2
                CLS = "Ｂ"
            Case "C", "c"
                CL_NO = 3
                CLS = "Ｃ"
            Case "D", "d"
                CL_NO = 4
                CLS = "Ｄ"
        End Select
            St = "終了"
            GoSub BOX
    Loop
    
    YE = CL_BEG(CL_NO) + NUM - 1   '印字終了時のパラメータ
'ワークシート設定
    Sheets("WorkSheet 3").Select
    Range("A1:Y80").Select
'印刷設定
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
        .PrintArea = "$A$1:$Y$80"
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.1)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait '縦方向に印字
        .Draft = False
        .PaperSize = xlPaperB4 'B4用紙に印字
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = True
        .Zoom = False
    End With
'個人表作成
N = 10 '個人票印字人数
If YS = YE Then
        FLAG = 1   '１人のみの印字時ON
    Else
        FLAG = 0
End If
    Do Until Y >= YE + FLAG
        
            Sheets("得点").Select
            Select Case Cells(Y, 1)
                Case "Ａ"
                    Range(Cells(ALL + 8, 1), Cells(ALL + 8, 25)).Select   'Ａクラス平均
                Case "Ｂ"
                    Range(Cells(ALL + 9, 1), Cells(ALL + 9, 25)).Select   'Ｂクラス平均
                Case "Ｃ"
                    Range(Cells(ALL + 10, 1), Cells(ALL + 10, 25)).Select   'Ｃクラス平均
                Case "Ｄ"
                    Range(Cells(ALL + 11, 1), Cells(ALL + 11, 25)).Select   'Ｄクラス平均
            End Select
            Selection.Copy
            Sheets("WorkSheet 2").Select
            Range(Cells(1, 1), Cells(1, 25)).Select
            ActiveSheet.Paste
            
            i = 2
            
        For K = 1 To 8 * N Step 8
    
            Sheets("得点").Select
            Range(Cells(Y, 1), Cells(Y, 25)).Select
            Selection.Copy
            Sheets("WorkSheet 2").Select
            Range(Cells(i, 1), Cells(i, 25)).Select
            ActiveSheet.Paste
    
            If Y >= YE Then
                K = 8 * N
            End If
            
            Sheets("得点").Select
            If Cells(Y, 2) > Cells(Y + 1, 2) Then
                K = 8 * N
            End If
            
            Y = Y + 1
            i = i + 1
            
        Next
    Calculate
    Sheets("WorkSheet 3").Select
    Range("A1:Y80").Select
    Selection.PrintOut Copies:=1
    
    Sheets("WorkSheet 2").Select
    Range("A1:Y11").Select
    Selection.ClearContents
    Loop
    
    Sheets("マクロボタン").Select
    Range("A1").Select
Exit Sub
    
CLDET:

クラス番号順並べ替え
    
Sheets("得点").Select
    NUMB = 1
    For CL_NO = 1 To 4
        CL_BEG(CL_NO) = NUMB + 4
            GoSub DET
        CL_END(CL_NO) = NUMB + 4
        CL_MEM(CL_NO) = CL_END(CL_NO) - CL_BEG(CL_NO) + 1
        NUMB = NUMB + 1: S = S + CL_MEM(CL_NO)
    Next
    ALL = S
Return

DET:
    Do Until Cells(NUMB + 4, 1) <> Cells(NUMB + 5, 1)
        NUMB = NUMB + 1
    Loop
Return

BOX:
    Do Until NUM * (NUM - CL_MEM(CL_NO)) <= 0
        NUM = InputBox("出席番号を入力してください(1〜" & Str(CL_MEM(CL_NO)) & ")", "印刷を" & St & "する生徒(" & CLS & "ｸﾗｽ)の出席番号")
    Loop
Return
End Sub
Sub 寮下宿生印字()
'
' 寮下宿生印字 マクロ
' ﾏｸﾛ記録日 : 1996/24/6  ﾕｰｻﾞｰ名 : H.Miyamoto
'  remake  6/24 '96
'  remake  6/14 '97
'
Dim K
Dim Y
Dim YS
Dim YE
Dim CLS
Dim NUM
    クラス番号順並べ替え
    Cells.Select
    With Selection.Font
        .Size = 10
    End With
    K = 0
    Y = 0
    NUM = 0
    If CLASS = "BA" Or CLASS = "BB" Or CLASS = "BG" Or CLASS = "RA" Or CLASS = "RB" Or CLASS = "RG" Or CLASS = "ba" Or CLASS = "bb" Or CLASS = "bg" Or CLASS = "ra" Or CLASS = "rb" Or CLASS = "rg" Then
    Else
        Sheets("高３ﾃｽﾄ得点").Select
        Do Until CLASS = "BG" Or CLASS = "RG" Or CLASS = "BA" Or CLASS = "BB" Or CLASS = "RA" Or CLASS = "RB" Or CLASS = "bg" Or CLASS = "rg" Or CLASS = "ba" Or CLASS = "bb" Or CLASS = "ra" Or CLASS = "rb"
            CLASS = InputBox("クラス名を入力してください(BA〜BG or RA〜RG)", "印刷開始する生徒のクラス名")
            Select Case CLASS
                    Case "BA", "ba"
                        CLS = 5
                        Do Until NUM > 0 And NUM < 35
                            NUM = InputBox("出席番号を入力してください(1〜34)", "印刷開始生徒(文Ａｸﾗｽ)の出席番号")
                        Loop
                    Case "BB", "bb"
                        CLS = 39
                        Do Until NUM > 0 And NUM < 34
                            NUM = InputBox("出席番号を入力してください(1〜33)", "印刷開始生徒(文Ｂｸﾗｽ)の出席番号")
                        Loop
                    Case "BG", "bg"
                        CLS = 72
                        Do Until NUM > 0 And NUM < 39
                            NUM = InputBox("出席番号を入力してください(1〜38)", "印刷開始生徒(文Ｇｸﾗｽ)の出席番号")
                        Loop
                    Case "RA", "ra"
                        CLS = 110
                        Do Until NUM > 0 And NUM < 37
                            NUM = InputBox("出席番号を入力してください(1〜36)", "印刷開始生徒(理Ａｸﾗｽ)の出席番号")
                        Loop
                    Case "RB", "rb"
                        CLS = 146
                        Do Until NUM > 0 And NUM < 38
                            NUM = InputBox("出席番号を入力してください(1〜37)", "印刷開始生徒(理Ｂｸﾗｽ)の出席番号")
                        Loop
                    Case "RG", "rg"
                        CLS = 183
                        Do Until NUM > 0 And NUM < 41
                            NUM = InputBox("出席番号を入力してください(1〜40)", "印刷開始生徒(理Ｇｸﾗｽ)の出席番号")
                        Loop
            End Select
        Loop
    End If
    YS = CLS + NUM - 1
    Y = YS
    CLASS = ""
    NUM = 0
        Do Until CLASS = "BG" Or CLASS = "RG" Or CLASS = "BA" Or CLASS = "BB" Or CLASS = "RA" Or CLASS = "RB" Or CLASS = "bg" Or CLASS = "rg" Or CLASS = "ba" Or CLASS = "bb" Or CLASS = "ra" Or CLASS = "rb"
            CLASS = InputBox("クラス名を入力してください(BA〜BG or RA〜RG)", "印刷終了する生徒のクラス名")
            Select Case CLASS
                    Case "BA", "ba"
                        CLS = 5
                        Do Until NUM > 0 And NUM < 35
                            NUM = InputBox("出席番号を入力してください(1〜34)", "印刷終了生徒(文Ａｸﾗｽ)の出席番号")
                        Loop
                    Case "BB", "bb"
                        CLS = 39
                        Do Until NUM > 0 And NUM < 34
                            NUM = InputBox("出席番号を入力してください(1〜33)", "印刷終了生徒(文Ｂｸﾗｽ)の出席番号")
                        Loop
                    Case "BG", "bg"
                        CLS = 72
                        Do Until NUM > 0 And NUM < 39
                            NUM = InputBox("出席番号を入力してください(1〜38)", "印刷終了生徒(文Ｇｸﾗｽ)の出席番号")
                        Loop
                    Case "RA", "ra"
                        CLS = 110
                        Do Until NUM > 0 And NUM < 37
                            NUM = InputBox("出席番号を入力してください(1〜36)", "印刷終了生徒(理Ａｸﾗｽ)の出席番号")
                        Loop
                    Case "RB", "rb"
                        CLS = 146
                        Do Until NUM > 0 And NUM < 38
                            NUM = InputBox("出席番号を入力してください(1〜37)", "印刷終了生徒(理Ｂｸﾗｽ)の出席番号")
                        Loop
                    Case "RG", "rg"
                        CLS = 183
                        Do Until NUM > 0 And NUM < 41
                            NUM = InputBox("出席番号を入力してください(1〜40)", "印刷終了生徒(理Ｇｸﾗｽ)の出席番号")
                        Loop
            End Select
        Loop
    
    YE = CLS + NUM - 1
    Sheets("WorkSeet").Select
    ActiveCell.Range("A1:AI65").Select
    ActiveWorkbook.Names.Add Name:="WORKSE", RefersToR1C1:= _
        "=WorkSeet!R1C1:R72C34"
    Range("A1").Select
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$AH$72"
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.1)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintNotes = False
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperB4
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = True
        .Zoom = False
    End With
    Do Until Y >= YE
        K = 1
        For K = 1 To 72 Step 8
            Sheets("高３ﾃｽﾄ得点").Select
            Range("HYODAI1").Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K, 1), Cells(K + 2, 34)).Select
            ActiveSheet.Paste
    
            Sheets("高３ﾃｽﾄ得点").Select
            Range(Cells(Y, 1), Cells(Y, 34)).Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K + 3, 1), Cells(K + 3, 34)).Select
            ActiveSheet.Paste
    
            Sheets("高３ﾃｽﾄ得点").Select
            Range("KYOKAI").Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K + 4, 1), Cells(K + 4, 34)).Select
            ActiveSheet.Paste
    
            Sheets("高３ﾃｽﾄ得点").Select
            Range("HEIKIN_ALL").Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K + 5, 1), Cells(K + 5, 34)).Select
            ActiveSheet.Paste
    
            Sheets("高３ﾃｽﾄ得点").Select
            Select Case Cells(Y, 1)
                Case "文Ａ"
                    Range("HEIKIN_BA").Select
                Case "文Ｂ"
                    Range("HEIKIN_BB").Select
                Case "文Ｇ"
                    Range("HEIKIN_BG").Select
                Case "理Ａ"
                    Range("HEIKIN_RA").Select
                Case "理Ｂ"
                    Range("HEIKIN_RB").Select
                Case "理Ｇ"
                    Range("HEIKIN_RG").Select
            End Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K + 6, 1), Cells(K + 6, 34)).Select
            ActiveSheet.Paste
            
            Sheets("高３ﾃｽﾄ得点").Select
            Range("KIRITORI").Select
            Selection.Copy
            Sheets("WorkSeet").Select
            Range(Cells(K + 7, 1), Cells(K + 7, 1)).Select
            ActiveSheet.Paste
            
            If Y >= YE Then
                K = 72
            End If
            
            Sheets("高３ﾃｽﾄ得点").Select
            If Cells(Y, 2) > Cells(Y + 1, 2) Then
                K = 72
            End If
            
            Y = Y + 1
            
        Next
    Sheets("WorkSeet").Select
    Range("WORKSE").Select
    Selection.PrintOut Copies:=1
    Selection.ClearContents
    Loop
    Sheets("マクロボタン").Select
    Range("A1").Select
End Sub
'
' 一覧表印字 マクロ
' ﾏｸﾛ記録日 : 1995/4/23  ﾕｰｻﾞｰ名 : H.Miyamoto
'  remake  6/14 '97
'  remake  5/2-4 '98
'
Sub 一覧表印字()

  Dim ALL As Integer
  
  文字属性変更

  Sheets("得点").Select   '学年人数設定
    NU = 1
    Do Until Cells(NU + 4, 3) = Cells(4, 3)
        NU = NU + 1
    Loop
  ALL = NU - 1
    
    Sheets("WorkSheet 1").Select
    Cells.Select
    Selection.RowHeight = 13 '　B4２ページ分；NX-500で印字すること
    
    成績順並べ替え
    
    Range("A1:Y1,A3:Y4").Select '表題１タイトルコピー
    Selection.Copy
    Sheets("WorkSheet 1").Select
    Range("A1").Select
    ActiveSheet.Paste
    
    Sheets("得点").Select
    Range("AA3").Select '比較タイトルコピー
    Selection.Copy
    Sheets("WorkSheet 1").Select
    Range("Y2").Select
    ActiveSheet.Paste
    
    Sheets("得点").Select
    Range(Cells(5, 1), Cells(ALL + 13, 25)).Select
    Selection.Copy
    Sheets("WorkSheet 1").Select
    Range("A4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    Sheets("得点").Select
    Range(Cells(5, 27), Cells(ALL + 13, 27)).Select
    Selection.Copy
    Sheets("WorkSheet 1").Select
    Range("Y4").Select
    ActiveSheet.Paste
    Range(Cells(1, 1), Cells(ALL + 13, 25)).Select
    
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$3"
        .PrintTitleColumns = ""
    End With
    With ActiveSheet.PageSetup
        .PrintArea = "$A$1:$Y$72"
        .FitToPagesWide = 1
        .FitToPagesTall = 4
        .LeftHeader = "&""MS 明朝,太字""［校外秘］"
        .CenterHeader = "&D"
        .RightHeader = "&P ﾍﾟｰｼﾞ"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(1)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.8)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.4)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintNotes = False
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperB4
        .FirstPageNumber = xlAutomatic
        .Order = xlOverThenDown
        .BlackAndWhite = True
        .Zoom = False
        .FitToPagesTall = 2
        End With
    Selection.PrintOut Copies:=1
    Range("$A$1:$Y$72").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("マクロボタン").Select
    Range("A1").Select

    Sheets("WorkSheet 1").Select
    Cells.Select
    Selection.RowHeight = 12
    Sheets("マクロボタン").Select
    
    文字属性解除

End Sub