中小学课程表模板最终版下载和Excel源码

去年我发过 中小学课程表模板下载 ，下载量还可以，后台也有人在问一些问题，看来还是不少人需要的，所以今天做了更新，跟我的 公文模板 一样，应该是最终版了。

为了追求自动化、幂等和精确性，我这个Excel模板是用程序生成的，文后一并把Excel的VBA源代码送给大家。

我是两个孩子的爸，我承包了两个宝所有的课程表更新。

模板下载位置 https://dog.xmu.edu.cn/images/2024/syllabus/中小学课程表模板-公众号-郑海山dump.xlsx

使用流程

• 打开Excel，有2个Sheet，一个是课程表详细版，一个是课程表简版
• 查看红色区域编辑并且仔细复查
  • 只需更新下面元数据和右边时间，再更新具体课程内容。
  • 根据右边时间“分钟/行高”数字更新行高。建议小于15分钟就15，超过45分钟就45。
  • 只需更新详细版，简版会相应更新
  • 为了解决有些6节有些7节，还有些“眼操”在不同节间，所以所有大节前后都预留了空行，如果不需要某行，在L列写入“隐藏”文字并且筛选一下即可，不要删除，不要删除。
• 生成PDF，注意所有Sheet都生成
• 打开PDF，放大到最大，截图分享在班级群里

小说明

• PDF方便家长直接打印
• 截图方便家长保存到手机
• 简版包括1 全简版，方便放在文具盒或者贴在课本上
• 和2 淡化或高亮某些课程的简版，方便整理第二天的书包，因为语数课本每天都要带的，而美术可能要带美术袋。

一些实现细节

• 引入版本机制，方便家长对照
• 学校、季节、学期等等元数据进行了剥离，免得不小心改错了，公式是类似 =CONCATENATE(J4, J5, “课程表”)
• 课程开始时间和结束时间也剥离了，自动统计课程时间
• 设定行高跟课时时间一致。比如45分钟，行高就是45，15分钟行高就是15
• 打印区域，设置了打印区域，辅助的数据不打印
• SSOT，课程表简版数据来源于详细版，只需要维护详细版即可，简版会自动更新
• 做了底色区分，不使用彩色
• 淡化语数的简版使用了条件格式，如果文本包括“语文”、“数学”则颜色变淡，淡化哪些课程目前可自定义。

Excel截图

Excel详细版

Excel简版

课程表真实截图

详细版

简版

源代码

大部分人不用关注下面这个。

Option Explicit

Private COLOR_GRAY1 As Long, COLOR_GRAY2 As Long, COLOR_GRAY3 As Long, COLOR_GRAY4 As Long
Private i As Integer, j As Integer, h As Integer

Sub Main()
    Call InitGlobalVars

    Call EnsureTwoSheets

    Sheets(1).Select
    Call UISetTitle
    Call SetMainTimeTable
    Call SetClassDurationTable
    Call SetHideSplitColumn
    Call SetHintMsg
    Call SetMetadata
    Range("D24").Select
   
    Sheets(2).Select
    Call SetSheet2BriefTimeTable
    Range("A1").Select
    
    Sheets(1).Select
End Sub

Sub DataValueMainTimeTable()
    i = 3

    i = i + 1: SetTimeTableClassNameDetail i, "节次   星期一 星期二   星期三  星期四  星期五"
    i = i + 2: SetTimeTableClassNameDetail i, "1      语文    数学    数学    生物    生物"
    i = i + 2: SetTimeTableClassNameDetail i, "2      语文    数学    语文    语文    语文"
    i = i + 2: SetTimeTableClassNameDetail i, "3      数学    音乐    音乐    科学    语文"
    i = i + 2: SetTimeTableClassNameDetail i, "4      音乐    语文    体育    劳动    语文"
    i = i + 2: SetTimeTableClassNameDetail i, "5      美术    体育    英语    美术    设计"
    i = i + 2: SetTimeTableClassNameDetail i, "6      体育    写字    计算机  体育    美术"
    i = i + 2: SetTimeTableClassNameDetail i, "7      掼蛋    跳绳    游泳    写字    舞蹈"
    
    Range("C5").Value = "大课间体育活动"
    Range("C7").Value = "眼操": Range("L7").Value = "隐藏"
    Range("C9").Value = "眼操"
    Range("C11").Value = "眼操": Range("L11").Value = "隐藏"
    Range("C13").Value = "午餐、午间延时服务"
    Range("C15").Value = "眼操": Range("L15").Value = "隐藏"
    Range("C17").Value = "眼操": Range("L17").Value = "隐藏"
    Range("C19").Value = "作业、校本、社团等"
End Sub

Sub DataValueClassDurationTable()
    i = 4

    i = i + 1: SetClassDurationDetail i, "08:20 08:50"
    i = i + 1: SetClassDurationDetail i, "08:50 09:30"
    i = i + 1: SetClassDurationDetail i, "09:30 09:40"
    i = i + 1: SetClassDurationDetail i, "09:40 10:20"
    i = i + 1: SetClassDurationDetail i, "10:20 10:25"
    i = i + 1: SetClassDurationDetail i, "10:30 11:10"
    i = i + 1: SetClassDurationDetail i, "11:10 11:20"
    i = i + 1: SetClassDurationDetail i, "11:20 12:00"

    i = i + 1: SetClassDurationDetail i, "12:00 14:00"
    i = i + 1: SetClassDurationDetail i, "14:30 15:10"
    i = i + 1: SetClassDurationDetail i, "15:10 15:20"
    i = i + 1: SetClassDurationDetail i, "15:30 16:10"
    i = i + 1: SetClassDurationDetail i, "16:10 16:20"
    i = i + 1: SetClassDurationDetail i, "16:20 17:05"
    i = i + 1: SetClassDurationDetail i, "17:05 17:50"
End Sub

Sub DataValueHint()
    Range("C20").Value = "周一升旗仪式开始时间7:30。" & vbCrLf & "当天无体育课的班级，应在下午活动时间组织学生进行30分钟体育锻炼。" & vbCrLf & "全面落实大课间体育活动制度，每天上午统一安排30分钟大课间体育活动。"
    Rows(20).RowHeight = 46
End Sub

Sub DataValueMetadata()
    Range("D24").Value = """郑海山dump""中学"
    Range("D25").Value = "冬令时"
    Range("D26").Value = "2023"
    Range("D27").Value = "2024"
    Range("D28").Value = "一"
    Range("D29").Value = "到5.31"
    Range("D30").Value = "初一(1)班"
    Range("D31").Value = "v" & Format(Date, "YYYYMMDD")
End Sub

Sub DataValueSheet2BriefTimeTableIgnoreHighlight()
    Range("O10").Value = "忽略课程"
    Range("O11").Value = "语文"
    Range("O12").Value = "数学"
    Range("O13").Value = "英语"
    Range("O14").Value = "写字"
    
    Range("P10").Value = "高亮课程"
    Range("P11").Value = "体育"
    Range("P12").Value = "美术"
End Sub

' Ignore all down
Function TrimAndSplit(strLine As String)
    Do While (InStr(strLine, "  "))
        strLine = Replace(strLine, "  ", " ")
    Loop
    TrimAndSplit = Split(strLine, " ")
End Function

Sub SetTimeTableClassNameDetail(i As Integer, strLine As String)
    Dim arrResult() As String
    arrResult = TrimAndSplit(strLine)

    For j = 0 To 6 - 1
        Range(Choose(j + 1, "A", "C", "D", "E", "F", "G") & i).Value = arrResult(j)
    Next j
End Sub

Sub SetClassDurationDetail(i As Integer, str As String)
    Dim arr() As String
    arr = TrimAndSplit(str)
    Range("I" & i).Value = arr(0)
    Range("J" & i).Value = arr(1)
End Sub

Sub EnsureTwoSheets()
    Sheets(1).Name = "课程表"
    Sheets(1).PageSetup.Orientation = xlLandscape
    Sheets(1).PageSetup.PrintArea = "$A$2:$G$20"

    If Worksheets.Count < 2 Then
        Sheets.Add After:=ActiveSheet
    End If
    Sheets(2).Name = "课程表简版"
    Sheets(2).PageSetup.Orientation = xlLandscape
    Sheets(2).PageSetup.PrintArea = "$A$1:$M$34"
End Sub

Sub UISetTitle()
    Range("A2:G2").Merge
    Range("A2").Value = "=CONCATENATE(D24, D25, ""课程表"" )"
    Range("A3:G3").Merge
    Range("A3").Value = "=CONCATENATE("""", D26, ""～"", D27, ""年度第"", D28, ""学期"", D29, ""   "", D30, "" "", D31)"

    With Range("A2:G2").Font
        .Name = "黑体"
        .Size = 24
    End With
    With Range("A3:G3").Font
        .Name = "楷体"
        .Size = 11
    End With
    With Range("A2:G3")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

Sub SetMainTimeTable()
    Call DataValueMainTimeTable
    
    Range("B4").Value = "时间"
    
    Columns("A:A").ColumnWidth = 6.2
    Columns("B:B").ColumnWidth = 8.4
    Columns("C:G").ColumnWidth = 20
    Rows(4).RowHeight = 31

    Range("A3:G3").HorizontalAlignment = xlRight

    Range("A4:G4").Interior.Color = COLOR_GRAY1
    Range("C5:G18").Interior.Color = COLOR_GRAY4
    Range("A5:A19").Interior.Color = COLOR_GRAY1
    Range("A14:A19").Interior.Pattern = xlGray16
    
    ' Split Bar
    For j = 5 To 19 Step 2
        Range("C" & j & ":G" & j).Select
        Selection.Merge
        Selection.Interior.Color = COLOR_GRAY3
    Next j

    AddCellBordersToRange Range("A4:G19")

    With Range("A4:G19")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "楷体"
        .Font.Size = 24
    End With
    
    Columns("B:B").NumberFormatLocal = "G/通用格式"
    With Range("B5:B19")
        .Value = "=CONCATENATE(I5, "" "",J5)"
        .WrapText = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Interior.Color = COLOR_GRAY2
        With .Font
            .Name = "楷体"
            .Size = 11
        End With
    End With
End Sub

Sub SetClassDurationTable()
    Range("I4").Value = "开始"
    Range("J4").Value = "结束"
    Range("K4").Value = "分钟/行高"

    Columns("I:K").ColumnWidth = 8.4
    With Range("I4:K4")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Interior.Color = vbRed
        .Font.Color = vbWhite
        .Font.Size = 18
    End With
    Range("K4").Font.Size = 12

    Columns("I:J").NumberFormatLocal = "@"
    Call DataValueClassDurationTable
    
    Columns("K:K").NumberFormatLocal = "G/通用格式"
    Range("K5:K19").Value = "=HOUR(TIMEVALUE(RC[-1]) - TIMEVALUE(RC[-2])) * 60 + MINUTE(TIMEVALUE(RC[-1]) - TIMEVALUE(RC[-2]))"
    
    AddCellBordersToRange Range("I4:K19")
   
    On Error Resume Next
    
    For j = 5 To 19
        h = WorksheetFunction.IfError(Range("K" & j).Value, 15)
        If h < 15 Then
            h = 15
        End If
        If h > 60 Then
            h = 45
        End If
        
        Rows(j & ":" & j).RowHeight = h
        If h <= 15 Then
            With Range("B" & j)
                .Font.Size = 8
                .WrapText = False
            End With
            Range("C" & j).Font.Size = 14
        End If
    Next j
   
    Call SetClassDurationBarColor
End Sub

Sub SetClassDurationBarColor()
    Range("K5:K20").Select
    Selection.FormatConditions.AddDatabar
    Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueAutomaticMin
        .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
    End With
    With Selection.FormatConditions(1).BarColor
        .Color = COLOR_GRAY3
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).BarFillType = xlDataBarFillGradient
    Selection.FormatConditions(1).Direction = xlContext
    Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
    Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
    Selection.FormatConditions(1).NegativeBarFormat.BorderColorType = _
        xlDataBarColor
    With Selection.FormatConditions(1).BarBorder.Color
        .Color = COLOR_GRAY4
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
    With Selection.FormatConditions(1).AxisColor
        .Color = 0
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).NegativeBarFormat.Color
        .Color = 255
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).NegativeBarFormat.BorderColor
        .Color = 255
        .TintAndShade = 0
    End With
End Sub

Sub SetHideSplitColumn()
    Columns("L").ColumnWidth = 10
    
    Range("L1").Value = "是否隐藏"
    
    With Range("L1")
        .Interior.Color = vbRed
        .Font.Color = vbWhite
        .Font.Bold = True
    End With

    Columns("L").AutoFilter
    ' ActiveSheet.Range("$L$2:$L$26").AutoFilter Field:=1, Criteria1:="="
End Sub

Sub SetHintMsg()
    Range("C20:F20").Merge
    Call DataValueHint
End Sub

Sub SetMetadata()
    Range("C24").Value = "学校"
    Range("C25").Value = "季节"
    Range("C26").Value = "学年开始"
    Range("C27").Value = "学年结束"
    Range("C28").Value = "学期"
    Range("C29").Value = "结束"
    Range("C30").Value = "班级"
    Range("C31").Value = "最后更新"
    
    Call DataValueMetadata
    
    With Range("C24:C31")
        .Interior.Color = vbRed
        .Font.Color = vbWhite
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    With Range("D24:D31")
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlCenter
    End With

    AddCellBordersToRange Range("C24:D31")
End Sub

Sub AddCellBordersToRange(rng As Range)
    rng.Borders(xlDiagonalDown).LineStyle = xlNone
    rng.Borders(xlDiagonalUp).LineStyle = xlNone
    Dim x As Variant
    For Each x In Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
        With rng.Borders(x)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    Next
End Sub

Sub SetSheet2BriefTimeTableOne(rng As Range)
    With rng
        .Range(Cells(1, 2), Cells(1, 6)).Value = "=课程表!C$4"
        .Range(Cells(2, 2), Cells(2, 6)).Value = "=课程表!C$6"
        .Range(Cells(3, 2), Cells(3, 6)).Value = "=课程表!C$8"
        .Range(Cells(4, 2), Cells(4, 6)).Value = "=课程表!C$10"
        .Range(Cells(5, 2), Cells(5, 6)).Value = "=课程表!C$12"
        .Rows().RowHeight = 16
        .Rows(6).RowHeight = 5
        .Range(Cells(7, 2), Cells(7, 6)).Value = "=课程表!C$14"
        .Range(Cells(8, 2), Cells(8, 6)).Value = "=课程表!C$16"
        .Range(Cells(9, 2), Cells(9, 6)).Value = "=课程表!C$18"
    
        For h = 2 To 9
            .Cells(h, 1).Value = "第" & Choose(h - 1, "一", "二", "三", "四", "", "五", "六", "七") & "节"
        Next h
        .Cells(6, 1).Value = ""
        
        .Cells(10, 6).Value = "=课程表!D31"
    
        AddCellBordersToRange .Range(Cells(1, 1), Cells(9, 6))
        
        With .Range(Cells(1, 2), Cells(1, 6))
            .Font.Bold = True
            .Interior.Color = COLOR_GRAY4
        End With
    
        With .Range(Cells(2, 1), Cells(5, 1))
            .Font.Bold = True
            .Interior.Color = COLOR_GRAY3
        End With
    
        With .Range(Cells(7, 1), Cells(9, 1))
            .Font.Bold = True
            .Interior.Color = COLOR_GRAY2
        End With
    End With

End Sub

Sub SetSheet2BriefTimeTableFormatConditions(strStart As String)
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($O$10:$O$17," & strStart & ")"
    Selection.FormatConditions(1).Font.Color = COLOR_GRAY3
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=COUNTIF($P$10:$P$17," & strStart & ")"
    Selection.FormatConditions(2).Font.Bold = True
    Selection.FormatConditions(2).Interior.Color = COLOR_GRAY4
End Sub

Sub SetSheet2BriefTimeTable()
    For i = 1 To 25 Step 12
        For j = 1 To 8 Step 7
            SetSheet2BriefTimeTableOne ActiveSheet.Range(Cells(i, j), Cells(i + 9, j + 5))
        Next j
    Next i
    
    With Range("A1:P34")
        .Font.Name = "宋体"
        .Font.Size = 11
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    Columns("A").ColumnWidth = 8
    Columns("B:F").ColumnWidth = 9
    Columns("H").ColumnWidth = 8
    Columns("I:M").ColumnWidth = 9
    
    With Range("O10:P10")
        .Interior.Color = vbRed
        .Font.Color = vbWhite
        .Font.Size = 12
    End With
    
    Call DataValueSheet2BriefTimeTableIgnoreHighlight
    AddCellBordersToRange Range("O10:P17")

    Range("B26:F33").Select
    SetSheet2BriefTimeTableFormatConditions "B26"
    Range("I26:M33").Select
    SetSheet2BriefTimeTableFormatConditions " I26"
End Sub

Sub InitGlobalVars()
    COLOR_GRAY1 = RGB(166, 166, 166)
    COLOR_GRAY2 = RGB(191, 191, 191)
    COLOR_GRAY3 = RGB(217, 217, 217)
    COLOR_GRAY4 = RGB(242, 242, 242)
End Sub