FM７ 成績ファイル作成３ 体裁を整える
前回、各教員が成績処理をするための名列が入ったEXCELファイルを出力しました。
今回は、そのEXCELファイルへの入力が間違いなくされるように、EXCELファイルの体裁を整えます。
今回はFileMakerを使いません。
１．フォルダの構成
適当なフォルダを作り、そのフォルダの直下にマクロ有効ブック「配布ファイルへ変換」を作ります。
更に、「マクロ」「配布ファイル」というフォルダを作ります。
「入力ファイル」は前回作った校務支援システムから出力されるEXCELファイルです。
２．配布ファイルへ変換マクロ
マクロ有効ブック「配布ファイルへ変換」には次の２つのマクロを作ります。
Sub 定期考査配布ファイル()
Dim DIR_PATH As String
Dim MacroFilename1 As String
Dim MacroFilename2 As String
Dim MacroFilename3 As String
DIR_PATH = ThisWorkbook.Path
MacroFilename1 = DIR_PATH & "\マクロ\printmacro.bas"
MacroFilename2 = DIR_PATH & "\マクロ\heikinketten.bas"
MacroFilename3 = DIR_PATH & "\マクロ\passreset.bas"
Dim fl_name As String
Dim fl_namebase As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
fl_name = Dir(DIR_PATH & "\入力ファイル\*.xlsx") 'ファイル名
If fl_name = "" Then
MsgBox "Excelファイルがありません。"
Exit Sub
End If
Application.ScreenUpdating = False '画面更新を停止
Do
fl_namebase = fso.GetBaseName(DIR_PATH & "\入力ファイル\" & fl_name) '拡張子無しファイル名
Workbooks.Open _
Filename:=DIR_PATH & "\入力ファイル\" & fl_name
' ＃＃＃表題＃＃＃
Cells(1, 2) = "授業ID"
Cells(1, 3) = "授業名"
Cells(1, 4) = "回数"
Cells(1, 8) = "氏名"
Cells(1, 9) = "素点"
Cells(1, 10) = "平均点"
Cells(1, 11) = "欠点"
Cells.Select
Cells.EntireColumn.AutoFit
' ＃＃＃欠点色（条件付き書式）
Range("I2:I56").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLessEqual, _
Formula1:="=$K$2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
' ＃＃＃呼び出し（ボタン作成（オートフィット後）,マクロ，ロック）
Call ボタン作成
' ＃＃＃アンロック
Range("I2:K56").Select
Selection.Locked = False
Selection.FormulaHidden = False
' ＃＃＃シートロック
ActiveSheet.Protect Password:="sheetlock", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
' ＃＃＃マクロを組み込む
Workbooks(fl_name).VBProject.VBComponents.Import MacroFilename1
Workbooks(fl_name).VBProject.VBComponents.Import MacroFilename2
Workbooks(fl_name).VBProject.VBComponents.Import MacroFilename3
' ＃＃＃出力
ActiveWorkbook.SaveAs Filename:= _
DIR_PATH & "\配布ファイル\" & fl_namebase & ".xlsm" _
, Password:="pass", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.Close
fl_name = Dir
Loop Until fl_name = ""
Set fso = Nothing
MsgBox "終了しました"
End SubSub ボタン作成()
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 100, 100, 50). _
Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "値を確定し，印刷をする。"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
Selection.OnAction = "値を確定し印刷"
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 40, 100, 50). _
Select
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "クラス平均・欠点自動計算"
With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 12). _
ParagraphFormat
.FirstLineIndent = 0
.Alignment = msoAlignLeft
End With
Selection.OnAction = "平均点欠点挿入"
End Subこのマクロは、校務支援システムから出力されたEXCELファイルに条件付き書式をつけ、シートの保護をし、マクロを入れ込み、ボタンを作成し、パスワード付きのマクロ有効ブックとして「配布ファイル」フォルダに保存するというものです。
入れ込むマクロは次の３つです。「マクロ」のフォルダに入れておきます。
heikinketten.bas
Sub 平均点欠点挿入()
Dim ave As Double
Dim averound As Double
Dim ketten As Integer
Dim i As Long
ave = WorksheetFunction.Average(Range("I2:I56"))
averound = WorksheetFunction.Round(ave, 1)
If (ave / 2) = Int(ave / 2) Then
ketten = (ave / 2) - 1
Else
ketten = Int(ave / 2)
End If
For i = 2 To Range("A2").End(xlDown).Row
Cells(i, "J").Value = averound
Cells(i, "K").Value = ketten
Next i
End Subprintmacro.bas
Sub 値を確定し印刷()
Dim kai As Integer
kai = Cells(2, 4).Value
For i = 2 To 56
For j = 9 To 11
If IsNumeric(Cells(i, j).Value) = True Then
Else
MsgBox (i & " 行 " & j & " 列目に数値以外が入力されています。")
Cells(i, j).Select
End If
Next j
Next i
For i = 2 To 56
If Cells(i, "I").Value = Int(Cells(i, "I").Value) Then
Else
MsgBox i & " 行 9 列目に小数が含まれています。整数値で入力してください。"
Cells(i, "I").Select
End
End If
Next i
Dim filename As String
filename = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Dim ans As Long
Dim ansk As Long
ans = MsgBox("値を確定し，印刷をしますか。[はい]を選択したあと，ファイルは閉じられ，編集を行うことはできません。確定後に訂正を行う場合は，管理者に連絡してください。", vbYesNo)
If ans = vbYes Then
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintGridlines = True '---罫線を表示
.CenterHeader = "&11教科担当印 &50□ 第 "& kai &" 回定期考査" '---タイトルは毎回変わる
.LeftFooter = "□ 【採点直後】 答案をスキャンし保存した。" & Chr(10) & "□ 【入力】 自分のコンピュータに入力した点数と、実際の答案の点数が一致していることひとりひとりを確認した。" & Chr(10) & "□ 【入力】 楽々くんへの入力の際、貼り付けるデータのクラス・科目を確認し、ずれることなく貼り付けた。" & Chr(10) & "□ 【他者確認】 この短冊の入力が正しいことを他の先生に点検してもらった。（ 月 日 時 分） 確認者 印"
.TopMargin = Application.CentimetersToPoints(3) '---3cmの余白
.FitToPagesTall = 1 '---縦方向1ページで印刷
.FitToPagesWide = 1 '---横方向1ページで印刷
.Orientation = xlPortrait '---縦方向で印刷
.PaperSize = xlPaperA3 '---A3で印刷
End With
Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:=filename, Password:="lock"
ActiveWorkbook.Close
Else
MsgBox "[いいえ]が押されました。編集を続けてください。"
End If
End Subpassreset.bas
Sub パスワード初期化()
Dim filename As String
filename = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:=filename, Password:="pass"
ActiveWorkbook.Close
End Sub１つ目は、平均点と欠点を計算して、入力するマクロです。
２つ目は、印刷を行うマクロです。印刷する前に入力されているものがすべて数値であるかをチェックします。さらに、素点は整数値で入力されているかをチェックします。問題なければ、印刷を行います。印刷タイトルには「第○回定期考査素点」と入ります。フッターにはミス防止チェック項目が入ります。印刷後、内容の変更ができないようにパスワードが変わります。
３つ目は、印刷後、内容の変更をしたいときに使います。各教員は管理者へ連絡し、管理者が３つ目のマクロを使ってパスワードをリセットします。
今回は簡単のため初期パスワードを「pass」、印刷後のパスワードを「lock」にしています。
印刷後のパスワードをマクロの中に直接書き込んでいます。これでは、マクロを見られたらパスワードがバレてしまいますので、なにか対策が必要です。
３．出来上がり
このようなEXCELファイルが出来上がります。
素点の欄が赤くなっていますが、点数を打ち込むと色が消えます。
素点を入力し、「平均・欠点自動計算」ボタンを押すと次のようになります。欠点は赤色に表示されます。
入力がよければ、「値を確定し、印刷する」ボタンを押します。
A3サイズの帳票として出力されます。
４．教員ごとフォルダ作成
変換マクロを使って作ったEXCELを教員ごとのフォルダに分けます。
「配布ファイル」フォルダにmove.batを作ります。
move.bat
SETLOCAL enabledelayedexpansion
for %%f in (*.xlsm) do (
set FMcodeFull=%%f
set FMcode=!FMcodeFull:~0,7!
IF EXIST !FMcode! (
move !FMcode!* !FMcode!
)
IF not EXIST !FMcode! (
md !FMcode!
move !FMcode!* !FMcode!
)
)
ENDLOCALこれを実行すると職員コードごとのフォルダが出来上がります。
これを学内の共有フォルダに入れて作業してもらいます。
次回は各教員が成績処理を行ったあと、回収し、FileMakerにインポートします。
いいなと思ったら応援しよう！
