Sub 任课教师节次表() |
Dim arr |
Dim str As String |
Dim i, j, k, m, n |
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet |
str = "高三" |
Application.ScreenUpdating = False |
Application.DisplayAlerts = False |
Set ws = Worksheets(str & "年级课表" ) |
i = Application.WorksheetFunction.CountA(ws.Rows(1)) |
arr = Range(ws.Cells(4, 1), ws.Cells(81, i)) |
'处理括号 |
arr(1, 1) = "星期" : arr(1, 2) = "节次" |
For j = 1 To i |
If arr(1, j) Like "*(*" Then |
arr(1, j) = Replace(Replace(StrConv(arr(1, j), vbNarrow), "(" , "" ), ")" , "" ) |
End If |
Next |
'提出教师姓名 |
For j = 2 To UBound(arr) |
For k = 3 To i |
arr(j, k) = Mid(arr(j, k), InStr(arr(j, k), Chr(10)) + 1) |
Next |
Next |
'处理特殊情况,班会/生态文明等 |
For j = 1 To i |
If arr(54, j) Like "*/*" Then |
arr(54, j) = Mid(arr(54, j), InStr(arr(54, j), "/" ) + 1, 10) |
End If |
Next |
'结果输出 |
k = 0 |
For Each ws2 In Sheets |
If ws2.Name = str & "教师" Then |
k = 1 |
End If |
Next |
If k = 1 Then |
Sheets(str & "教师" ).Delete |
End If |
Sheets.Add after:=Sheets(Sheets.Count) |
Sheets(Sheets.Count).Name = str & "教师" |
Set ws1 = Sheets(str & "教师" ) |
Range(ws1.Cells(1, 1), ws1.Cells(1, i - 1)).Merge |
With Range(ws1.Cells(1, 1), ws1.Cells(1, i - 1)) |
.Font.Size = 24 |
.HorizontalAlignment = xlCenter |
End With |
ws1.Range( "a1" ) = "开阳一中2020-2021学年度第一学期教师任课节次表(" & str & "年级)" |
ws1.Cells(1, i) = Format(Now, "mmdd" ) |
With ws1.Cells(2, 1).Resize(UBound(arr), i) |
.Value = arr |
.Borders.LineStyle = xlContinuous |
End With |
For j = 57 To 3 Step -1 |
If ws1.Cells(j, 2) = "第九节" Or ws1.Cells(j, 2) = "晚自习" Then |
Range( "a" & j).EntireRow.Delete |
End If |
Next |
Range( "a48:a69" ).EntireRow.Delete |
For j = 3 To 47 |
If Cells(j, 1) <> "" Then |
Range( "a" & j & ":a" & j + 8).Merge |
End If |
Next |
With Range( "a3:a60" ) |
.Orientation = xlVertical |
.HorizontalAlignment = xlCenter |
.VerticalAlignment = xlCenter |
End With |
Columns( "b:aa" ).ColumnWidth = 6 |
Columns( "a:a" ).ColumnWidth = 4 |
Application.DisplayAlerts = True |
Application.ScreenUpdating = True |
Call 晚自习 |
Call 打印设置 |
End Sub |
Sub 晚自习() |
Dim ws As Worksheet, ws1 As Worksheet, ws2 As Worksheet |
Dim i, j, k, m, n |
Dim arr, brr() |
Dim str As String |
Application.ScreenUpdating = False |
Application.DisplayAlerts = False |
str = "高三" |
Set ws = Sheets( "高三年级课表" ) |
For Each ws2 In Sheets |
If ws2.Name = str & "晚" Then |
k = 1 |
End If |
Next |
If k = 1 Then |
Sheets(str & "晚" ).Delete |
End If |
ws.Copy after:=Sheets(Sheets.Count) |
Sheets(Sheets.Count).Name = "高三晚" |
Set ws1 = Sheets( "高三晚" ) |
ws1.Range( "a5:a14" ).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove |
For i = 81 To 5 Step -1 |
If Cells(i, 1) = "" Or Cells(i, 1).Value = "星期六" Then |
Range( "a" & i).EntireRow.Delete |
End If |
Next |
Cells(10, 1) = "星期日" |
Columns(2).Delete |
j = Application.WorksheetFunction.CountA(Rows(1)) |
Rows(3).Delete |
Rows(1).Delete |
Cells(2, 1).Value = "星期" |
arr = Range(ws1.Cells(2, 1), ws1.Cells(8, j)) |
For k = 1 To j |
If arr(1, k) Like "*(*" Then |
arr(1, k) = Replace(Replace(StrConv(arr(1, k), vbNarrow), "(" , "" ), ")" , "" ) |
End If |
Next |
ReDim brr(1 To 7, 1 To j) |
For n = 1 To j |
brr(1, n) = arr(1, n) |
brr(2, n) = arr(7, n) |
For m = 3 To 7 |
brr(m, n) = arr(m - 1, n) |
Next |
Next |
ws1.Range( "a3" ).Resize(7, j) = brr |
ws1.Range( "a3" ).Resize(11, j).Borders.LineStyle = xlContinuous |
ws1.Range( "a3" ).Resize(7, j).HorizontalAlignment = xlCenter |
ws1.Range( "a3" ).Resize(7, j).VerticalAlignment = xlCenter |
Range(ws1.Cells(1, 1), ws1.Cells(1, j)).Merge |
With Range(ws1.Cells(1, 1), ws1.Cells(1, j - 1)) |
.Font.Size = 20 |
.HorizontalAlignment = xlCenter |
End With |
ws1.Range( "a1" ) = "开阳一中2020-2021学年度第一学期晚自习检查表(" & str & "年级)" |
Range(ws1.Cells(2, 1), ws1.Cells(2, j - 1)).Merge |
ws1.Range( "a2" ).Font.Size = 14 |
ws1.Range( "a2" ).HorizontalAlignment = xlCenter |
ws1.Cells(2, 1) = "第 周 从 月 日至 月 日" |
ws1.Cells(2, j) = Format(Now, "mmdd" ) |
With Range( "a4:a9" ) |
.Orientation = xlVertical |
.HorizontalAlignment = xlCenter |
.VerticalAlignment = xlCenter |
End With |
Range(Cells(10, 1), Cells(10, j)).Merge |
Range(Cells(11, 1), Cells(11, j)).Merge |
Range(Cells(12, 1), Cells(12, j)).Merge |
Range(Cells(13, 1), Cells(13, j)).Merge |
Range(Cells(10, 1), Cells(10, j)).Font.Size = 14 |
Range( "a10" ) = "备注" |
Columns( "b:aa" ).ColumnWidth = 6 |
Columns( "a:a" ).ColumnWidth = 4 |
Rows(3).RowHeight = 25 |
Rows( "4:9" ).RowHeight = 45 |
Rows( "10:13" ).RowHeight = 30 |
Application.DisplayAlerts = True |
Application.ScreenUpdating = True |
Call 打印设置 |
End Sub |
Sub 打印设置() |
Application.PrintCommunication = False '中断打印机的通信 |
With ActiveSheet.PageSetup |
.PrintTitleRows = "" '设置打印表头比如= "$1:$2"为设置第一二两行为表头 |
.PrintTitleColumns = "" '设置打印左侧重复列数 |
End With |
Application.PrintCommunication = True '恢复打印机的通信 |
ActiveSheet.PageSetup.PrintArea = "" '打印区域,以字符串的形式= "$A$1:$Y$47" |
Application.PrintCommunication = False '中断打印机的通信 |
With ActiveSheet.PageSetup |
.LeftHeader = "" '返回或设置工作簿或节的左页眉上的文本对齐方式。 |
.CenterHeader = "" '居中对齐 PageSetup 对象中的页眉信息。可读/写 String 类型。 |
.RightHeader = "" '返回或设置页眉的右边部分内容。可读/写 String 类型。 |
.LeftFooter = "" '返回或设置工作簿或节的左页脚上的文本对齐方式。 |
.CenterFooter = "" '居中对齐 PageSetup 对象中的页脚信息。可读/写 String 类型。 |
'(磅:指打印的字符的高度的度量单位。1 磅等于 1/72 英寸,或大约等于 1 厘米的 1/28。) |
.RightFooter = "" '返回或设置页面右边缘与页脚右边界之间的距离(以磅为单位)。可读/写 String 类型 |
.LeftMargin = Application.InchesToPoints(0) '以磅为单位返回或设置左边距的大小。Double 类型,可读写。 |
.RightMargin = Application.InchesToPoints(0) '以磅 为单位返回或设置右边距的大小。Double 类型,可读写。 |
.TopMargin = Application.InchesToPoints(0.393700787401575) '以磅 为单位返回或设置上边距的大小。Double 类型,可读写。 |
.BottomMargin = Application.InchesToPoints(0) '以磅 为单位返回或设置底端边距的大小。Double 类型,可读写。 |
.HeaderMargin = Application.InchesToPoints(0) '以磅为单位返回或设置页面顶端到页眉的距离。Double 类型,可读写。 |
.FooterMargin = Application.InchesToPoints(0) '以磅 为单位返回或设置页脚到页面底端的距离。Double 类型,可读写。 |
.PrintHeadings = False '如果打印本页时同时打印行标题和列标题,则该值为 True。仅应用于工作表。Boolean 类型,可读写。 |
.PrintGridlines = False '如果在页面上打印单元格网格线,则该值为 True。仅应用于工作表。Boolean 类型,可读写。 |
.PrintComments = xlPrintNoComments '返回或设置批注随工作表打印的方式。XlPrintLocation 类型,可读写。 |
.PrintQuality = 600 '返回或设置打印质量。Variant 类型,可读写。 |
.CenterHorizontally = True '水平居中为true,不选则为false |
.CenterVertically = False '垂直居中为true,不选则为false |
.Orientation = xlLandscape '横向打印,纵向为xlPortrait |
.Draft = False '如果打印工作表时不打印其中的图形,则该属性值为 True。Boolean 类型,可读写。 |
.PaperSize = xlPaperA4 '返回或设置纸张大小。可读写 XlPaperSize。 |
.FirstPageNumber = xlAutomatic '返回或设置打印指定工作表时第一页的页号。如果设为 xlAutomatic,则 Microsoft Excel 采用第一页的页号。默认值为 xlAutomatic。Long 类型,可读写。 |
.Order = xlDownThenOver '返回或设置一个 XlOrder 值,该值代表 Microsoft Excel 打印一张大工作表时用于对页进行编号的顺序。 |
.BlackAndWhite = False '如果指定文档中的元素以黑白方式打印,则该属性值为 True。Boolean 类型,可读写。 |
.Zoom = False '自动缩放,它代表一个数值在 10% 到 400% 之间的百分比,也可以直接=95即为缩放到原来的95% |
.FitToPagesWide = 1 '调整为1页 |
.FitToPagesTall = 1 '调整为1页高,=false时为N页高 |
.PrintErrors = xlPrintErrorsDisplayed '设置或返回一个 XlPrintErrors 常量,该常量指定显示的打印错误类型。该功能允许用户在打印工作表时取消错误显示。可读写。 |
.OddAndEvenPagesHeaderFooter = False '如果指定的 PageSetup 对象的奇数页和偶数页具有不同的页眉和页脚,则该属性值为 True。Boolean 类型,可读写。 |
.DifferentFirstPageHeaderFooter = False '如果在第一页使用不同的页眉或页脚,则为 True。可读/写 Boolean 类型。 |
.ScaleWithDocHeaderFooter = True '返回或设置页眉和页脚是否在文档大小更改时随文档缩放。可读/写 Boolean 类型。 |
.AlignMarginsHeaderFooter = True '如果 Excel 以页面设置选项中设置的边距对齐页眉和页脚,则返回 True。可读/写 Boolean 类型。 |
|
End With |
Application.PrintCommunication = True '恢复打印机的通信 |
End Sub |