Ｈ-2 所見欄一覧表サンプルシート
以下にサンプルシートを掲げます。
「所見欄Readme」シート
「所見欄」シート
索引
ページの先頭へ戻る
目次へ戻る
| Section H 所見欄一覧表 |
作成の基本方針
・生徒の名簿欄は、「マスターテーブル.xls」からコピーする。
・所見の記入欄は5行として、コピーした名簿に生徒1人に付き4行分を新規に挿入する。
・1学期〜3学期まで1年間の所見欄を追加する。
なお、所見欄のセル幅は、通知表の所見記載欄のセル幅と同じとする。
H-1 所見欄作成
[メインプログラム]
メインのマクロプログラムは、3つのサブプログラムから構成されています。
「所見欄名簿準備main」マクロプログラム
1 Sub 所見欄名簿準備main()
2 Call 名簿コピー
3 Call 行の挿入
4 Call 所見欄セル準備
5 End Sub
[名簿コピー]マクロプログラム
このマクロは、「マスターテーブル.xls」ブックの「マスターテーブル」シートの表の内、
「名簿Tbl」で登録されたセル範囲をコピーして「所見欄」シートに貼り付けるマクロです。
プログラム末尾で見出し行を1行追加挿入しています。
「名簿コピー」マクロプログラム
1 Sub 名簿コピー()
2 Dim mySht As Worksheet, row As Integer, col As Integer
3 Sheets("所見欄").Select
4 '3：1000行までの削除〜既存の名簿削除
5 Rows("3:1000").Select
6 Selection.Delete Shift:=xlUp
7 'マスターテーブルから読込
8 Workbooks.Open Filename:=ThisWorkbook.Path
& "\マスターテーブル.xls"
9 Sheets("マスターテーブル").Select
10 '名簿貼付
11 Application.Goto Reference:="名簿Tbl"
12 Selection.Copy
13 Workbooks("所見一覧表.xls").Activate
14 Sheets("所見欄").Select
15 row = 4
16 col = 2
17 Cells(row, col).Select
18 ActiveSheet.Paste
19 Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
20 SkipBlanks:=False, Transpose:=False
21 ' 見出しの下に1行挿入（学期見出し記入用セル）
22 Rows("5").Select
23 Selection.Insert Shift:=xlDown
24 End Sub
「名簿コピー」マクロプログラムの解説
5,6 行目 ：既存の所見欄があると支障が生ずるので、3〜1000行まで最初に削除します。
22,23行目 ：見出しを1行分挿入します。
「行の挿入」マクロプログラム
このマクロでは、名簿に記載された一番下の生徒番号セルの絶対アドレスを検出して、
何行目まで空白行を挿入すべきかを決めています。
「行の挿入」マクロプログラム
1 Sub 行の挿入() '所見欄のスペースを5行分確保するため、4行挿入
2 Dim myAdr As String, i As Integer, num As Integer
3 Dim ins As Integer
4 Dim myRng1 As Range, myRng2 As Range ' Tips A-020
5 Set myRng1 = Cells(Rows.Count, 4) '下端(65536行)のセルを取得,
'2番目の引数は列を表現
6 '（即ち、生徒番号）
7 With myRng1
8 If Len(.PrefixCharacter & .Formula) >
0 Then
9 Set myRng2 = myRng1 '下端のセルが該当する場合
10 Else
11 With .End(xlUp)
12 If Len(.PrefixCharacter & .Formula) >
0 Then
13 Set myRng2 = .Cells(1) '引数1は何かが入力されている最終セル行を表現
14 End If
15 End With
16 End If
17 End With
18 If myRng2 Is Nothing Then
19 MsgBox "何も入力されていません"
20 Else
21 MsgBox myRng2.Address
22 End If
23 Set activeRng = myRng2 'インプットボックスで選択されたアクティブセルを
'activeRngにセット
24 Set myRng1 = Nothing 'オブジェクトの解放
25 Set myRng2 = Nothing
26 ' end of Tips A-020
27 ' 表に記載された生徒数
28 Range("H6") = activeRng.Address
'絶対アドレスをH6セルに表示
29 Range("I6").Select
30 ActiveCell.FormulaR1C1 = "=VALUE(RIGHT(RC[-1],LEN(RC[-1])-3))"
31 '絶対アドレスから行番号を取り出して数値化
32 total_student = Range("I6")
- 5 ' -5:絶対アドレス行番号から表の生徒数を
'求める際の調整
33 'マスターテーブルの開始行を変更する時は修正必要
34 Range("H6:I6").Select
35 Selection.ClearContents '一時的なセル表示を消去
36 '行の挿入
37 For num = 1 To total_student
38 ins = 7 + (num - 1) * 5
39 myAdr = CStr(ins) 'Tips A044
40 Rows(myAdr).Select
41 For i = 1 To 4 '4行挿入
42 Selection.Insert Shift:=xlDown
43 Next
44 Next
45 '罫線調整
46 For num = 1 To total_student
47 ins = 6 + (num - 1) * 5
48 myAdr = "B" &
CStr(ins) & ":" & "F"
& CStr(ins + 4) 'Tips A044
49 'Range("B6:F10").Select
50 Range(myAdr).Select
51 Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
52 Selection.Borders(xlDiagonalUp).LineStyle
= xlNone
53 With Selection.Borders(xlEdgeLeft)
54 .LineStyle = xlContinuous
55 .Weight = xlThin
56 .ColorIndex = xlAutomatic
57 End With
58 With Selection.Borders(xlEdgeTop)
59 .LineStyle = xlContinuous
60 .Weight = xlThin
61 .ColorIndex = xlAutomatic
62 End With
63 With Selection.Borders(xlEdgeBottom)
64 .LineStyle = xlContinuous
65 .Weight = xlThin
66 .ColorIndex = xlAutomatic
67 End With
68 With Selection.Borders(xlEdgeRight)
69 .LineStyle = xlContinuous
70 .Weight = xlThin
71 .ColorIndex = xlAutomatic
72 End With
73 With Selection.Borders(xlInsideVertical)
74 .LineStyle = xlContinuous
75 .Weight = xlThin
76 .ColorIndex = xlAutomatic
77 End With
78 Selection.Borders(xlInsideHorizontal).LineStyle
= xlNone
79 Next
80 End Sub
「行の挿入」マクロプログラムの解説
4〜26行目 ：これは、下記の参考文献に掲載されているTipsA-020の引用です。
渡辺ひかる著、「Excel
VBA 実用サンプルコレクション」
,
SOFT BANK Publishing.
この文献には、有用なTipsが多数掲載されているので、絶対お勧めです。
5行目でsheetの最終行（65536行目）の4列目のセルがｍｙRng1にセット
されます。
8行目〜.PrefixCharacterは、接頭辞を返すプロパティで文字列を表すシングル
クォーテーション「’」かNull値を返します。セルの値が「’」のみの場合
には見た目が空白セルと同じに見えるので、このような処理が必要
です。.Formulaは、数式を返すプロパティです。
11行目〜Endプロパティを使って、最終行から上の行に向かって走査します。
21行目〜指定された列において、何かが入力されている一番下のセル（即ち、
下から走査して最初に見つかったセル）の絶対アドレスをMsgBoxに
表示します。サンプルの絶対アドレスは$D$35です。
28〜30行目 ：絶対セルのアドレスをH6セルに表示し、I6にはH6セルの文字列右端から文字
列長−3（つまり$D$の3文字分）、即ち上の例では35、を取り出し数値化します。
32行目 ：名簿は、「名簿コピー」マクロの15行目のコードにあるように、（4,2)セルを表の
左上隅として貼り付けられたので、30行目のコードでI6セルに表示された行を
表す数値から5を引いた値が表の末尾の生徒番号（＝全生徒数）に一致します。
37〜44行目 ：各生徒の生徒番号が表示されている行の下に、新規に4行挿入します。
（注意）このコードから明らかなように、このマクロでは生徒番号が1番から連続
して欠番が無く最後の生徒番号になっていることを、前提としています。
48行目 ：アドレス文字列を作成して、罫線を調整するセル範囲を決めています。
CStr( )は、（ ）内のinsで与えられる数値を文字列化しています。
78行目 ：50行目で選択されたセル範囲内部に含まれる水平罫線を「表示せず」とします。
46と80行目 ：罫線の調整は次第に行をずらし全生徒分行うため、For〜Next文で繰り返します。
なお、変数total_studentは、次の「所見欄セル準備」マクロでも
使用するので、次のようにPublic宣言（セクションＦのＦ−2参照）をします。
Public total_student As Integer
「所見欄セル準備」マクロプログラム
このマクロは、すでに貼り付けた名簿の右横に所見欄を追加します。
「所見欄セル準備」マクロプログラム
1 Sub 所見欄セル準備()
2 Dim myAdr As String, semst As Integer
3 Range("F3") = "所見欄一覧表"
'表題
4 ' 文字列の記入
5 Range("H4") = "所見欄"
6 Range("G5") = "1学期"
7 Range("H5") = "2学期"
8 Range("I5") = "3学期"
9 '罫線枠
10 Range("G4:I5").Select
11 With Selection.Borders(xlEdgeLeft)
12 .LineStyle = xlContinuous
13 .Weight = xlThin
14 .ColorIndex = xlAutomatic
15 End With
16 With Selection.Borders(xlEdgeTop)
17 .LineStyle = xlContinuous
18 .Weight = xlThin
19 .ColorIndex = xlAutomatic
20 End With
21 With Selection.Borders(xlEdgeBottom)
22 .LineStyle = xlContinuous
23 .Weight = xlThin
24 .ColorIndex = xlAutomatic
25 End With
26 With Selection.Borders(xlEdgeRight)
27 .LineStyle = xlContinuous
28 .Weight = xlThin
29 .ColorIndex = xlAutomatic
30 End With
31 With Selection.Borders(xlInsideVertical)
32 .LineStyle = xlContinuous
33 .Weight = xlThin
34 .ColorIndex = xlAutomatic
35 End With
36 With Selection.Borders(xlInsideHorizontal)
37 .LineStyle = xlContinuous
38 .Weight = xlThin
39 .ColorIndex = xlAutomatic
40 End With
41 '列幅変更
42 Columns("G:I").Select
43 Selection.ColumnWidth = 32.5 '通知表通信欄の所見記入セル幅に同じ
44 'セル内背景カラー指定
45 Range("G4:I5").Select
46 With Selection.Interior
47 .ColorIndex = 41
48 .Pattern = xlSolid
49 End With
50 ' 文字列センタリング
51 Range("G4:I5").Select
52 With Selection
53 .HorizontalAlignment = xlCenter
54 .VerticalAlignment = xlCenter
55 End With
56 ' セル範囲外枠罫線
57 For semst = 1 To 3
58 For num = 1 To total_student
59 ins = 6 + (num - 1) * 5
60 If semst = 1 Then
61 myAdr = "G"
& CStr(ins) & ":" & "G" &
CStr(ins + 4) 'Tips A044
62 'Range("G6:G10").Select
63 ElseIf semst = 2 Then
64 myAdr = "H"
& CStr(ins) & ":" & "H"
& CStr(ins + 4) 'Tips A044
65 Else
66 myAdr = "I"
& CStr(ins) & ":" & "I"
& CStr(ins + 4) 'Tips A044
67 End If
68 Range(myAdr).Select
69 Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
70 Selection.Borders(xlDiagonalUp).LineStyle
= xlNone
71 With Selection.Borders(xlEdgeLeft)
72 .LineStyle = xlContinuous
73 .Weight = xlThin
74 .ColorIndex = xlAutomatic
75 End With
76 With Selection.Borders(xlEdgeTop)
77 .LineStyle = xlContinuous
78 .Weight = xlThin
79 .ColorIndex = xlAutomatic
80 End With
81 With Selection.Borders(xlEdgeBottom)
82 .LineStyle = xlContinuous
83 .Weight = xlThin
84 .ColorIndex = xlAutomatic
85 End With
86 With Selection.Borders(xlEdgeRight)
87 .LineStyle = xlContinuous
88 .Weight = xlThin
89 .ColorIndex = xlAutomatic
90 End With
91 Selection.Borders(xlInsideHorizontal).LineStyle
= xlNone
92 Next
93 Next
94 End Sub
「所見欄セル準備」マクロプログラムの解説
43行目 ：42行目で選択したセル範囲の各セルについて、列幅を半角32.5文字分として
指定します。
57〜93行目：2重のFor〜Next文によって、先ず1学期の生徒番号1から順に最後の生徒
番号欄までを罫線で囲みます。次いで同様に2学期、3学期と罫線で囲む作業
が進められます。
Ｈ-2 所見欄一覧表サンプルシート
以下にサンプルシートを掲げます。
「所見欄Readme」シート
「所見欄」シート
索引
ページの先頭へ戻る
目次へ戻る