'=========================================================================================
'　301　繰り返し処理で全員の個票を印刷する
'-----------------------------------------------------------------------------------------
'【ヒント】
' このマクロは、おためし機能の動作用のコードを含んでいます。（概ね下半分）
' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。（概ね上半分）


'=========================================================================================
' ◆標準モジュールのコード◆
'-----------------------------------------------------------------------------------------
Option Explicit
Dim グラフ番号                                  '★★★
Dim 下端 As Variant                             '★★★
Dim 行 As Variant                               '★★★
Dim タイトル As String
Dim スタイル As Long
Dim メッセージ As String
Dim 応答 As Variant
Dim リスタート As Integer
'=========================================================================================
Private Sub 繰り返し処理で全員の個票を印刷する()  '★★★
    Worksheets("成績").Activate                 '成績シートをアクティブにする
        下端 = Range("A3").End(xlDown).Row      '下端検出
    Worksheets("個票").Activate                 '個票シートをアクティブにする
'
    For 行 = 3 To 下端                          '（成績シートの）3行目から下端行まで
        Range("A2").Value = Worksheets("成績").Cells(行, 1) '「成績」シートの番号を写す
        Application.ScreenUpdating = False      '画面を更新しない
        グラフを描く                            'サブプロシージャを実行する
    Next                                        '繰り返す
End Sub
'-----------------------------------------------------------------------------------------
Private Sub グラフを描く()                      'このサブプロシージャーは殆ど自動記録したままです
    ActiveSheet.ChartObjects.Add(0.75, 130, 270, 270).Select
    Application.CutCopyMode = False
    ActiveChart.ChartWizard Source:=Range("A4:E7"), Gallery:= _
        xlCombination, Format:=2, PlotBy:=xlRows, CategoryLabels:=1, _
        SeriesLabels:=1, HasLegend:=2, Title:="", CategoryTitle:="", _
         ValueTitle:="", ExtraTitle:=""
    グラフ番号 = "グラフ " & 行 + 5
    ActiveSheet.ChartObjects(グラフ番号).Activate
    ActiveChart.Axes(xlValue).Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlCross
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNextToAxis
    End With
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScale = 100
        .MinorUnit = 5
        .MajorUnit = 10
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = False
    End With
    ActiveChart.Axes(xlValue, xlSecondary).Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlCross
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNextToAxis
    End With
    With ActiveChart.Axes(xlValue, xlSecondary)
        .MinimumScaleIsAuto = True
        .MaximumScale = 20
        .MinorUnit = 1
        .MajorUnit = 2
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = False
    End With
    ActiveChart.PlotArea.Select
    With ActiveChart.Axes(xlCategory)
        .HasMajorGridlines = False
        .HasMinorGridlines = False
    End With
    With ActiveChart.Axes(xlValue)
        .HasMajorGridlines = True
        .HasMinorGridlines = False
    End With
'
    ActiveWindow.Visible = False
    Windows("301.xls").Activate
'    ActiveWindow.SelectedSheets.PrintOut        '印刷する（おためし用にコメント行にしてある）
    Sheets("個票").PrintPreview                   '印刷ブレビューする（おためし用）
'
    ActiveSheet.DrawingObjects(グラフ番号).Select
    Selection.Delete
End Sub
'=========================================================================================



'-----------------------------------------------------------------------------------------
Sub おためしマクロ()
    おためしメッセージを表示する
    If 応答 = vbYes Then                        'プリンタがインストールしてあれば
        繰り返し処理で全員の個票を印刷する      '★★★
    End If
    Worksheets("Title").Activate                'Titleシートをアクティブにする
End Sub
'-----------------------------------------------------------------------------------------
Private Sub おためしメッセージを表示する()
    Worksheets("成績").Select
    Range("A1").Select
    Range("L1").Select                         'カーソルを定位置へ移動する
    If リスタート = 0 Then
        タイトル = "500連発 第2弾 サンプルマクロ"
        スタイル = 32 + 4                           'vbQuestion + vbYesNo
        メッセージ = "一人づつ順番に個票を作成して、印刷プレビューします。" & Chr(13) & Chr(13) & _
                "プリンタがインストールしてないパソコンでは、" & Chr(13) & Chr(13) & _
                "うまく動作しません。" & Chr(13) & Chr(13) & _
                "プリンタはインストールされていますか"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
        If 応答 = vbYes Then
            リスタート = 1                      'リスタートを禁止するため
        End If
    Else
        スタイル = 16                           'vbCritical
        メッセージ = "リスタート機能は用意されてません。" & Chr(13) & Chr(13) & _
                "ブックを開きなおしてから、実行してください。"
        応答 = MsgBox(メッセージ, スタイル, タイトル)
        Auto_Close
    End If
End Sub
'-----------------------------------------------------------------------------------------
Sub Auto_Close()
    Application.DisplayAlerts = False           '閉じる際に確認メッセージを出さない
    ActiveWorkbook.Close                        '現在開いているブックを閉じる
End Sub
'-----------------------------------------------------------------------------------------