・「各種記録と通信欄−生徒名」のシート名で各生徒毎の各種記録と通信欄を作成。
・名簿欄表示画面上から、各種記録と通信欄ページを作成したい生徒のセル範囲を
選択可能とした後、「所見欄一覧表.xls」ブックの「所見欄」シートから、該当生徒の
所見を「各種記録と通信欄−生徒名」シートに転記する。
K-1 各種記録と通信欄作成プログラム
事前に、次のpublic宣言がされています。
Public student_name As String, student_no As Integer
Public grade As Integer, Class As Integer
Public scase As Integer, wcase As Integer
このマクロプログラムは、かなりの部分がセクションJのJ-3のマクロに重複しています。
重複するコードについては、J-3の説明を参照下さい。
「各種記録と通信欄作成」マクロプログラム
1 Sub 各種記録と通信欄作成()
2 Dim masterTbl As Range, sendTbl As Range, myRng As Range
3 Dim mySht As Worksheet, new_sheet_name As String
4 Dim syoken(3, 5) As String
5 '連結5段階評価.xlsの連結成績シートから読込
6 Workbooks.Open Filename:=ThisWorkbook.Path & "\連結5段階評価.xls"
7 Worksheets("連結成績").Activate 'シート名「連結成績」をアクティブシートにする
8 ' Tips A-003
9 myStr = "マウスで出力したい生徒番号のセル範囲を選択して、OKボタンを押してください"
10 On Error Resume Next
11 Set myRng = Application.InputBox(myStr, Type:=8)
12 On Error GoTo 0
13 If myRng Is Nothing Then
14 MsgBox "キャンセルされました"
15 End If
16 '
17 Set masterTbl = Range("連結成績")
18 '連結成績マスターテーブルと名付けた表のセル範囲をmasterTblにセット
19 Set activeRng = myRng 'インプットボックスで選択されたアクティブセルをactiveRngにセット
20 '選択範囲の取り出し
21 Workbooks("通知表.xls").Activate
22 Worksheets("表表紙").Activate
23 Range("B27") = activeRng.Address '絶対アドレスでセル範囲をB27セルに表示
24 If activeRng.Address Like "*:*" Then '選択人数複数の場合
25 Range("B28").Select
26 ActiveCell.FormulaR1C1 = "=LEFT(R[-1]C,FIND("":"",R[-1]C)-1)"
27 '絶対アドレス範囲の前半分をB28セルに表示
28 Range("B29").Select
29 ActiveCell.FormulaR1C1 = "=RIGHT(R[-2]C,LEN(R[-2]C)-FIND("":"",R[-2]C))"
30 '絶対アドレス範囲の後ろ半分をB29セルに表示
31 Range("C28").Select
32 ActiveCell.FormulaR1C1 = "=VALUE(RIGHT(RC[-1],LEN(RC[-1])-3))"
33 '絶対アドレスから行番号を取り出して数値化
34 ist = Range("C28") - 5 ' -5:絶対アドレス行番号から生徒番号を求める際の調整
35 '連結成績の開始行を変更する時は修正必要
36 Range("C29").Select
37 ActiveCell.FormulaR1C1 = "=VALUE(RIGHT(RC[-1],LEN(RC[-1])-3))"
38 iend = Range("C29") - 5
39 Else '選択人数1人の場合
40 Range("C28").Select
41 ActiveCell.FormulaR1C1 = "=VALUE(RIGHT(R[-1]C[-1],LEN(R[-1]C[-1])-3))"
42 '絶対アドレスから行番号を取り出して数値化
43 ist = Range("C28") - 5
44 iend = ist
45 End If
46 Range("B27:C29").Select
47 Selection.ClearContents '一時的なセル表示を消去
48 '
49 For k = ist To iend
50 If k <> ist Then
51 Workbooks("連結5段階評価.xls").Activate
52 Worksheets("連結成績").Activate 'シート名「連結成績」をアクティブシートにする
53 Set masterTbl = Range("連結成績")
54 End If
55 student_no = k
56 '（）内アドレスの内容をstudent_noに代入
57 grade = masterTbl.Cells(student_no + 2, 1).Value '行番号+2は見出し分、
58 '列番号1；masterTbl 内での相対列番号
59 Class = masterTbl.Cells(student_no + 2, 2).Value
60 student_name = masterTbl.Cells(student_no + 2, 4).Value
61 '
62 '各種記録と通信欄−生徒名として挿入
63 Workbooks("通知表.xls").Activate
64 Worksheets("各種記録と通信欄").Activate 'シート名「各種記録と通信欄」を
'アクティブシートにする
65 Set mySht = Worksheets("各種記録と通信欄")
66 With Worksheets
67 mySht.Copy After:=.Item(.Count) 'ワークシート「各種記録と通信欄」を
'最末尾にコピー
68 End With
69 Set mySht = ActiveSheet
70 new_sheet_name = "各種記録と通信欄" & "−" & student_name
71 Sheets(mySht.name).name = new_sheet_name '"各種記録と通信欄" & student_name
72 'シート「mySht.Name」の名前を「各種記録と通信欄−生徒名」に変更
73 '
74 '所見欄から読込
75 Workbooks.Open Filename:=ThisWorkbook.Path & "\所見一覧表.xls"
76 Worksheets("所見欄").Activate 'シート名「所見欄」をアクティブシートにする
77 Set sendTbl = Range("所見欄")
78 For sems = 1 To 3 'sems=1,2,3:1学期,2学期,3学期
79 For j = 1 To 5 'j=1〜5:ひと学期分の所見欄が5行で構成されて
'いることに対応
80 syoken(sems, j) = sendTbl.Cells(3 + (j - 1) + 5 * (student_no - 1), 6 + (sems - 1))
81 Next
82 Next
83 '通信欄に書き込み
84 Workbooks("通知表.xls").Activate
85 Worksheets(new_sheet_name).Activate
86 'シート名「各種記録と通信欄−生徒名」をアクティブシートにする
87 Set masterTbl = Range("通信欄")
88 For sems = 1 To 3 'sems=1,2,3:1学期,2学期,3学期
89 For j = 1 To 5
90 masterTbl.Cells(2 + (j - 1) + 5 * (sems - 1), 2) = syoken(sems, j)
91 Next
92 Next
93 Next 'k
94 Set MasterTbl = Nothing
95 Set sendTbl = Nothing
96 Set myRng = Nothing
97 End Sub
「各種記録と通信欄作成」マクロプログラムの解説
5〜47行目 ：セクションJのJ-3マクロプログラムに同じ。
49〜72行目 ：セクションJのJ-3マクロプログラムに同じ。
74〜82行目 ：所見欄一覧表からの読込
78〜82行目：2重のFor〜Next文の外側ループは1〜3学期に対応、
内側ループは1人分の所見欄セル5行に対応しています。
78行目から分かる様に、所見欄データの有無に係わらず
3回繰り返すので、作成学期に応じて未記入となるべき所見
欄は空白のままとしておきます。
80行目 ：所見欄の内容をセル毎に、変数syoken(sems,j)に代入
83〜92行目 ：「各種記録と通信欄−生徒名」シートの通信欄に所見を記入
K-2 各種記録と通信欄作成サンプルシート
以下にサンプルシートを掲げます。
図 K-1 「通知表Readme」シートの各種記録と通信欄作成手順
「各種記録と通信欄-生徒名」サンプルシートは、次のpdfファイルを参照下さい。
sample_3p.pdfへのリンク
索引
ページの先頭へ戻る
目次へ戻る