・手作業で各教科別観点リスト一覧表を準備する。
・国語観点評価記入表をマクロで作成する。
・他教科の観点評価記入表は、マクロで作成済教科の観点評価表をコピーし作成する。
・各生徒の観点評価は手作業でリストデータから入力する。
G-1 各教科別観点リスト一覧表作成
先ず、全教科の観点項目の一覧表を、前から2番目のシートにシート名を「各教科別観点
リスト」として作成します。先頭のシートには、「観点評価Readme」があると仮定しています。
G-3に掲げるマクロプログラムには、「先頭から○○番目のシートの後ろにコピーしなさい」
のようにシート枚数を利用するコードが有るので、シート枚数の指示に従って下さい。
サンプルでは、図G-1に示す一覧表を想定しています。この例の観点評価項目数は国語5、
社会〜英語4、選択教科3です。項目数と教科の並び順が異なる場合には、後述のマクロ
プログラムにおいて整合性がとれる様注意しましょう。
図 G-1 各教科別観点リスト一覧表
G-2 国語観点評価表作成プログラム
このマクロでは、先ずセクションFの「連結5段階.xls」ブックの国語成績シートから名簿
をコピーした後、観点評価欄を追加し、表の上段に上記リスト一覧から国語の評価項目
を挿入しています。
「国語観点評価表作成main」マクロプログラム
1 Sub 国語観点評価表作成main()
2 Call 国語観点評価名簿欄コピー
3 Call 国語観点評価欄追加
4 End Sub
「国語観点評価名簿欄コピー」マクロプログラム
1 Sub 国語観点評価名簿欄コピー()
2 Dim mySht As Worksheet
3 Sheets("国語観点評価").Select
4 '2:1000行までの削除〜既存の名簿削除
5 Rows("2:1000").Select
6 Selection.Delete shift:=xlUp
7 '
8 '連結5段階評価の国語成績シートから名簿の読込
9 Workbooks.Open Filename:=ThisWorkbook.Path & "\連結5段階評価.xls"
10 Sheets("国語成績").Select
12 Application.Goto Reference:="名簿Tbl"
13 Selection.Copy
14 Workbooks("観点評価.xls").Activate
15 Sheets("国語観点評価").Select
16 Row = 4
17 col = 2
18 Cells(Row, col).Select
19 ActiveSheet.Paste
20 Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
21 SkipBlanks:=False, Transpose:=False
22 End Sub
「国語観点評価名簿欄コピー」マクロプログラムの解説
9行目、14行目の追加はありますが、9〜21行目は基本的にはセクションFのF-3で
解説した「連結成績表作成準備」マクロプログラムの11〜20行に同じです。
5、6行目 ：これは、既存の「国語観点評価」シートがある場合、表の大きさが異なると
支障が生ずるため、一旦既存の表を削除しなさいの意味です。余裕を持って
1000行まで削除しています。
「国語観点評価欄追加」マクロプログラム
1 Sub 国語観点評価欄追加()
2 ' 文字列挿入
3 Range("E3") = "国語観点評価達成状況"
4 Range("G5") = "A"
5 Range("H5") = "B"
6 Range("I5") = "C"
7 Range("J5") = "D"
8 Range("K5") = "E"
9 Range("G5:K5").Select
10 Selection.Copy
11 Range("L5").Select
12 ActiveSheet.Paste
13 Range("Q5").Select
14 ActiveSheet.Paste
15 Range("I4") = "1学期"
16 Range("N4") = "2学期"
17 Range("S4") = "3学期"
18 '文字列センタリング
19 Range("I4,N4,S4,G5:U5").Select
20 With Selection
21 .HorizontalAlignment = xlCenter
22 .VerticalAlignment = xlCenter
23 .WrapText = False
24 .Orientation = 0
25 .AddIndent = False
26 .IndentLevel = 0
27 .ShrinkToFit = False
28 .ReadingOrder = xlContext
29 .MergeCells = False
30 End With
31 '罫線
32 Range("G5:U35").Select
33 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
34 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
35 With Selection.Borders(xlEdgeLeft)
36 .LineStyle = xlContinuous
37 .Weight = xlThin
38 .ColorIndex = xlAutomatic
39 End With
40 With Selection.Borders(xlEdgeTop)
41 .LineStyle = xlContinuous
42 .Weight = xlThin
43 .ColorIndex = xlAutomatic
44 End With
45 With Selection.Borders(xlEdgeBottom)
46 .LineStyle = xlContinuous
47 .Weight = xlThin
48 .ColorIndex = xlAutomatic
49 End With
50 With Selection.Borders(xlEdgeRight)
51 .LineStyle = xlContinuous
52 .Weight = xlThin
53 .ColorIndex = xlAutomatic
54 End With
55 With Selection.Borders(xlInsideVertical)
56 .LineStyle = xlContinuous
57 .Weight = xlThin
58 .ColorIndex = xlAutomatic
59 End With
60 With Selection.Borders(xlInsideHorizontal)
61 .LineStyle = xlContinuous
62 .Weight = xlThin
63 .ColorIndex = xlAutomatic
64 End With
65 '罫線 学期欄
66 Range("G4:K4,L4:P4,Q4:U4").Select
67 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
68 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
69 With Selection.Borders(xlEdgeLeft)
70 .LineStyle = xlContinuous
71 .Weight = xlThin
72 .ColorIndex = xlAutomatic
73 End With
74 With Selection.Borders(xlEdgeTop)
75 .LineStyle = xlContinuous
76 .Weight = xlThin
77 .ColorIndex = xlAutomatic
78 End With
79 With Selection.Borders(xlEdgeBottom)
80 .LineStyle = xlContinuous
81 .Weight = xlThin
82 .ColorIndex = xlAutomatic
83 End With
84 With Selection.Borders(xlEdgeRight)
85 .LineStyle = xlContinuous
86 .Weight = xlThin
87 .ColorIndex = xlAutomatic
88 End With
89 Selection.Borders(xlInsideVertical).LineStyle = xlNone
90 '
91 Range("G4:U5").Select
92 Selection.Interior.ColorIndex = 41
93 '列幅設定
94 Columns("G:U").Select
95 Selection.ColumnWidth = 2
96 '評価説明入力行の挿入
97 Rows("2").Select
98 For i = 1 To 5 '5行挿入
99 Selection.Insert shift:=xlDown
100 Next
101 '観点評価項目転記
102 Sheets("各教科別観点リスト").Select
103 Range("C3:C7").Select
104 Selection.Copy
105 Sheets("国語観点評価").Select
106 Range("D2").Select
107 ActiveSheet.Paste
108 '余分な罫線の削除
109 Range("D2:D6").Select
110 Application.CutCopyMode = False
111 Selection.Borders(xlEdgeLeft).LineStyle = xlNone
112 Selection.Borders(xlEdgeTop).LineStyle = xlNone
113 Selection.Borders(xlEdgeBottom).LineStyle = xlNone
114 Selection.Borders(xlEdgeRight).LineStyle = xlNone
115 End Sub
「国語観点評価欄追加」マクロプログラムの解説
長いマクロですが、単純な「マクロの記録」を順に繋げただけです。
2〜17行目 ：見出し文字列A〜E、1〜3学期の表示で、一部コピーを利用しています。
18〜30行目 ：上記文字列の中央寄せ（センタリング）です。23〜29行目は削除可です。
31〜64行目 ：A〜E欄の縦、横罫線の設定です。セル毎に罫線で仕切られます。
65〜89行目 ：学期の見出しについて罫線設定、ここではセル5個分をまとめて外枠罫線
として設定しています。
91,92行目 ：見出し行を青色で塗りつぶします。
94,95行目 ：列幅の設定で、単位は半角文字列2つ分の幅の意味です。
97〜100行目 ：表の上段に観点評価項目を記入するため、5行新たに挿入します。
101〜114行目：国語の観点評価項目を先の「各教科別観点リスト一覧表」からコピーして
「国語観点評価」シートのD2セルに貼り付けています。この際、罫線も含めて
コピーされるので、108〜114行目でそれを削除しています。
以上で国語観点評価記入表を準備することができましたが、A〜Eの観点評価（○,△,・, ）
については、手作業でセクションFのF-1で説明したリスト入力ができるよう設定しましょう。
この設定のマクロ化も可能ですが、次第にプログラムが複雑になるので省略しました。
G-3 各教科観点評価テーブル準備プログラム
このマクロでは、先ず国語観点評価表をコピーして、それを基に社会の観点評価表を作成
します。9教科の内、国語評価項目数は5つ、他の科目は4つなので、E欄を削除しています。
社会の観点評価表が完成した後は、それを基に科目名と評価項目の内容を差し替え、For〜
Next文で残り7科目分の観点評価表を準備します。
選択教科は年1回の評価となるので、欄構成が9教科とは異なります。このマクロでは、社会
の観点評価表を基に選択教科1の表を作り、その後選択教科2〜4をFor〜Next文の中で作成
する構造としています。
「各教科観点評価テーブル準備」マクロプログラム
1 Sub 各教科観点評価テーブル準備()
2 Dim subject As String, choice_item As String, ic As Integer, i As Integer
3 '社会観点評価
4 Sheets("国語観点評価").Activate
5 Sheets("国語観点評価").Copy After:=Sheets(3) ' (3)：前から3番目のシートの意味
6 Sheets("国語観点評価 (2)").Select
7 Sheets("国語観点評価 (2)").Name = "社会観点評価"
8 '複数セル内容のクリア
9 Range("E8,D2:D6").Select
10 Selection.ClearContents
11 '複数列の削除（評価項目E欄）
12 Range("K:K,P:P,U:U").Select
13 Selection.Delete shift:=xlToLeft
14 '観点評価項目転記
15 Sheets("各教科別観点リスト").Select
16 Range("C8:C11").Select
17 Selection.Copy
18 Sheets("社会観点評価").Select
19 Range("D2").Select
20 ActiveSheet.Paste
21 '余分な罫線の削除
22 Range("D2:D5").Select
23 Application.CutCopyMode = False
24 Selection.Borders(xlEdgeLeft).LineStyle = xlNone
25 Selection.Borders(xlEdgeTop).LineStyle = xlNone
26 Selection.Borders(xlEdgeBottom).LineStyle = xlNone
27 Selection.Borders(xlEdgeRight).LineStyle = xlNone
28 Range("E8") = "社会観点評価達成状況"
29 '見出し右端罫線記入
30 Range("O9:R9").Select
31 With Selection.Borders(xlEdgeRight)
32 .LineStyle = xlContinuous
33 .Weight = xlThin
35 .ColorIndex = xlAutomatic
36 End With
37 '数学〜英語の7科目
38 ic = 4 'コピーする際のシート位置制御
39 For i = 1 To 7
40 If i = 1 Then
41 subject = "数学"
42 choice_item = "C12:C15" '数学観点評価項目のセル位置
43 ElseIf i = 2 Then
44 subject = "理科"
45 choice_item = "C16:C19"
46 ElseIf i = 3 Then
47 subject = "音楽"
48 choice_item = "C20:C23"
49 ElseIf i = 4 Then
50 subject = "美術"
51 choice_item = "C24:C27"
52 ElseIf i = 5 Then
53 subject = "保健体育"
54 choice_item = "C28:C31"
55 ElseIf i = 6 Then
56 subject = "技術家庭"
57 choice_item = "C32:C35"
58 Else ' i = 7
59 subject = "英語"
60 choice_item = "C36:C39"
61 End If
62 '
63 Sheets("社会観点評価").Select
64 Sheets("社会観点評価").Copy After:=Sheets(ic)
65 Sheets("社会観点評価 (2)").Select
66 Sheets("社会観点評価 (2)").Name = subject & "観点評価"
67 '観点評価項目転記
68 Sheets("各教科別観点リスト").Select
69 Range(choice_item).Select
70 Selection.Copy
71 Sheets(subject & "観点評価").Select
72 Range("D2").Select
73 ActiveSheet.Paste
74 '余分な罫線の削除
75 Range("D2:D5").Select
76 Application.CutCopyMode = False
77 Selection.Borders(xlEdgeLeft).LineStyle = xlNone
78 Selection.Borders(xlEdgeTop).LineStyle = xlNone
79 Selection.Borders(xlEdgeBottom).LineStyle = xlNone
80 Selection.Borders(xlEdgeRight).LineStyle = xlNone
81 Range("E8") = subject & "観点評価達成状況"
82 ic = ic + 1
83 Next
84 '選択教科1
85 Sheets("社会観点評価").Select
86 Sheets("社会観点評価").Copy After:=Sheets(11)
87 Sheets("社会観点評価 (2)").Select
88 Sheets("社会観点評価 (2)").Name = "選択教科1観点評価"
89 'セル内容のクリア
90 Range("E8,D2:D5").Select
91 Selection.ClearContents
92 '複数列の削除（評価項目D欄）
93 Range("J:R").Select
94 Selection.Delete shift:=xlToLeft
95 'セル内容のクリア
96 Range("I9").Select
97 Selection.ClearContents
98 Range("H9") = "評価"
99 '文字列センタリング
100 Range("H9").Select
101 With Selection
102 .HorizontalAlignment = xlCenter
103 .VerticalAlignment = xlCenter
104 End With
105 '観点評価項目転記
106 Sheets("各教科別観点リスト").Select
107 Range("C40:C42").Select
108 Selection.Copy
109 Sheets("選択教科1観点評価").Select
110 Range("B2").Select
111 ActiveSheet.Paste
112 '余分な罫線の削除
113 Range("B2:B4").Select
114 Application.CutCopyMode = False
115 Selection.Borders(xlEdgeLeft).LineStyle = xlNone
116 Selection.Borders(xlEdgeTop).LineStyle = xlNone
117 Selection.Borders(xlEdgeBottom).LineStyle = xlNone
118 Selection.Borders(xlEdgeRight).LineStyle = xlNone
119 Range("E8") = "選択教科1観点評価達成状況"
120 '見出し右端罫線表示
121 Range("G9:I9").Select
122 With Selection.Borders(xlEdgeRight)
123 .LineStyle = xlContinuous
124 .Weight = xlThin
125 .ColorIndex = xlAutomatic
126 End With
127 ic = 12
128 For i = 1 To 3
129 If i = 1 Then
130 subject = "選択教科2"
131 ElseIf i = 2 Then
132 subject = "選択教科3"
133 Else ' i=3
134 subject = "選択教科4"
135 End If
136 Sheets("選択教科1観点評価").Select
137 Sheets("選択教科1観点評価").Copy After:=Sheets(ic)
138 Sheets("選択教科1観点評価 (2)").Select
139 Sheets("選択教科1観点評価 (2)").Name = subject & "観点評価"
140 Range("E8") = subject & "観点評価達成状況"
141 ic = ic + 1
142 Next
143 End Sub
「各教科観点評価テーブル準備」マクロプログラムの解説
5行目 ：前から3番目のシートの後に「国語観点評価」シートをコピーしなさい。
6行目 ：上記でコピーされた直後のシート名は、「国語観点評価(2)」となっています。
9,10行目 ：表の上段、表のタイトル記入セル（E8）と評価項目記入セル（D2:D6）を選択し、
内容を削除。
15〜17行目 ：社会の評価項目4つ（C8:C11）をコピーすると、各教科別観点リスト一覧表の
仕切り罫線も共にコピーされます。21〜27行目はその罫線の消去です。
38行目 ：先頭からのシート枚数を変数icで制御し、64行目でic番目のシートの後ろに
「社会観点評価」シートがコピーされます。82行目でicの値が1増えて、Nextで
39行目のForに戻り、再び64行目のicに反映されます。
40〜61行 ：文字変数subjectに科目名を文字変数choice_itemに該当科目の観点評価
項目のセル位置を代入します。代入される科目名などは、ループ変数 i に
応じて変わります。
84〜126行目 ：選択教科1の観点評価表を準備しています。社会の観点評価表をコピーして、
不要な欄を削除しています。
127〜143行目：選択教科1の表が作成済となり、For〜Next文で残り3科目を作成します。
