frmexcel.frm

VB编写的中小学监考老师排表软件

For i = 1 To Day * Class + 1
xlzsheet.Columns(i + 1).ColumnWidth = xlzsheet.Columns(i + 1).ColumnWidth * 0.9 '0.6
Next i
'行高
For i = 3 To bjs + 2
xlzsheet.Rows(i).RowHeight = xlzsheet.Rows(i).RowHeight * 3 '1.1
Next i
'表头和格线

With xlzsheet
'所有单元画细线
For i = 1 To bjs + 2
For j = 1 To Class * Day + 1
Cells(i, j).Borders.LineStyle = xlContinuous
Cells(i, j).Borders.Weight = xlThin
Next j
Next i

For j = 1 To Day

'首行'合并
.Range(.Cells(1, Class * (j - 1) + 2), .Cells(1, Class * j + 1)).Merge (True)
.Cells(1, Class * (j - 1) + 2).Value = Mid$("试期一试期二试期三试期四试期五试期六星期日", (j - 1) * 3 + 1, 3)

'粗行线
For i = 1 To Class + 1
.Cells(1, (j - 1) * Class + i).Borders(xlTop).LineStyle = xlContinuous
.Cells(1, (j - 1) * Class + i).Borders(xlTop).Weight = xlMedium

.Cells(2, (j - 1) * Class + i).Borders(xlTop).LineStyle = xlContinuous
.Cells(2, (j - 1) * Class + i).Borders(xlTop).Weight = xlMedium

.Cells(2, (j - 1) * Class + i).Borders(xlBottom).LineStyle = xlContinuous
.Cells(2, (j - 1) * Class + i).Borders(xlBottom).Weight = xlMedium
'未行
.Cells(bjs + 2, (j - 1) * Class + i).Borders(xlBottom).LineStyle = xlContinuous
.Cells(bjs + 2, (j - 1) * Class + i).Borders(xlBottom).Weight = xlMedium
Next i

'粗列线
For i = 1 To bjs + 2
Cells(i, Class * (j - 1) + 2).Borders(xlLeft).LineStyle = xlContinuous
Cells(i, Class * (j - 1) + 2).Borders(xlLeft).Weight = xlMedium
Next i

For i = 2 To bjs + 2
Cells(i, Class * (j - 1) + Class1 + 1).Borders(xlRight).LineStyle = xlContinuous
Cells(i, Class * (j - 1) + Class1 + 1).Borders(xlRight).Weight = xlMedium
Next i

Next j
'首列
For i = 1 To bjs + 2
Cells(i, 1).Borders(xlLeft).LineStyle = xlContinuous
Cells(i, 1).Borders(xlLeft).Weight = xlMedium

 '末列
Cells(i, Day * Class + 1).Borders(xlRight).LineStyle = xlContinuous
Cells(i, Day * Class + 1).Borders(xlRight).Weight = xlMedium
Next i
End With


For j = 1 To Day
For i = 1 To Class
'次行
xlzsheet.Cells(2, (j - 1) * Class + i + 1).Value = i
Next i
Next j
'填总课表内容
xlzsheet.Cells(1, 1) = "时间"
xlzsheet.Cells(2, 1) = "班级"

'取班级表
'Open App.Path + "\bjkcbiao.ran" For Random As #12 Len = Len(newbiao)

For b = 1 To bjs
'Get #12, b, newbiao
'首列班级名
newbjitem = bjarr(b)
strname = Left(newbjitem.njm, 2) + Left(newbjitem.bjh, 2)
xlzsheet.Cells(b + 2, 1).Value = strname
'课程
For i = 0 To Class - 1
For j = 0 To Day - 1

    If Trim(bjarr(b).ksbiao(i, j)) <> "x" Then
    strcell = Left(bjarr(b).ksbiao(i, j), 2)
    Else
    strcell = " "
    End If
    
    If Trim(bjarr(b).jsbiao1(i, j)) <> "x" Then
    strcell = strcell + Chr(10) + Left(bjarr(b).jsbiao1(i, j), 3)
    Else
    strcell = strcell + " "
    End If
    
    If Trim(bjarr(b).jsbiao2(i, j)) <> "x" Then
    strcell = strcell + Chr(10) + Left(bjarr(b).jsbiao2(i, j), 3)
    Else
    strcell = strcell + " "
    End If


'strcell = Left(newbjitem.ksbiao(i, j), 2) & Left(newbjitem.jsbiao1(i, j), 3)
'If Trim$(strcell) = "x" Then strcell = " "
xlzsheet.Cells(b + 2, j * Class + i + 2) = strcell ' Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
Next j
Next i

Next b
Exit Sub
'Close #12
'===============================
'建纵式总表

'Set xlzbook = xlApp.Workbooks.Add
Set xlzshsheet = xlzbook.Worksheets.Add
xlzshsheet.name = "纵式总表"
'居中
xlzshsheet.Columns.HorizontalAlignment = xlCenter
xlzshsheet.Rows.VerticalAlignment = xlCenter

'列宽
For i = 1 To bjs
xlzshsheet.Columns(i + 2).ColumnWidth = xlzshsheet.Columns(i + 2).ColumnWidth * 0.7
Next i
xlzshsheet.Columns(1).ColumnWidth = xlzshsheet.Columns(1).ColumnWidth * 0.5
xlzshsheet.Columns(2).ColumnWidth = xlzshsheet.Columns(2).ColumnWidth * 0.5
'行高
Dim h As Integer
h = xlzshsheet.Rows(1).RowHeight
xlzshsheet.Rows(1).RowHeight = h * 1.5
For i = 2 To Day * Class + 1
xlzshsheet.Rows(i).RowHeight = h * 1.2
Next i
With xlzshsheet

'所有单元画细线
For i = 1 To Day * Class + 1
For j = 1 To bjs + 2
Cells(i, j).Borders.LineStyle = xlContinuous
Cells(i, j).Borders.Weight = xlThin
Next j
Next i

'表头
.Cells(1, 1).Value = "星期"
.Cells(1, 2).Value = "节次"


For j = 1 To Day
.Cells((j - 1) * Class + 2, 1).Value = Mid$("一二三四五六日", j, 1)
.Range(.Cells((j - 1) * Class + 2, 1), .Cells(j * Class + 1, 1)).Merge (False)
Next j

For j = 1 To Day
For i = 1 To Class
.Cells(Class * (j - 1) + i + 1, 2).Value = i
Next i
Next j

'粗行线
For j = 1 To bjs + 2
'first line
.Cells(1, j).Borders(xlTop).LineStyle = xlContinuous
.Cells(1, j).Borders(xlTop).Weight = xlMedium
'second line
.Cells(1, j).Borders(xlBottom).LineStyle = xlContinuous
.Cells(1, j).Borders(xlBottom).Weight = xlMedium
'orther lines
For i = 1 To Day
.Cells(i * Class + 1, j).Borders(xlBottom).LineStyle = xlContinuous
.Cells(i * Class + 1, j).Borders(xlBottom).Weight = xlMedium
Next i
Next j
'午线
For j = 2 To bjs + 2
For i = 1 To Day
.Cells((i - 1) * Class + 1 + Class1, j).Borders(xlBottom).LineStyle = xlContinuous
.Cells((i - 1) * Class + 1 + Class1, j).Borders(xlBottom).Weight = xlMedium
Next i
Next j
'粗列线
For i = 1 To Day * Class + 1
.Cells(i, 1).Borders(xlLeft).LineStyle = xlContinuous
.Cells(i, 1).Borders(xlLeft).Weight = xlMedium
.Cells(i, 2).Borders(xlLeft).LineStyle = xlContinuous
.Cells(i, 2).Borders(xlLeft).Weight = xlMedium
.Cells(i, 2).Borders(xlRight).LineStyle = xlContinuous
.Cells(i, 2).Borders(xlRight).Weight = xlMedium
.Cells(i, bjs + 2).Borders(xlRight).LineStyle = xlContinuous
.Cells(i, bjs + 2).Borders(xlRight).Weight = xlMedium
Next i
'填课程
For b = 1 To bjs
Get #12, b, newbiao
'列首班级名
strname = Left$(newbiao.bj, 2) + Mid$(newbiao.bj, 7, 2)
.Cells(1, b + 2).Value = strname

For i = 0 To Class - 1
For j = 0 To Day - 1
strcell = Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
If Trim$(strcell) = "x" Then strcell = " "
.Cells(Class * j + i + 2, b + 2).Value = strcell
Next j
Next i
Next b
End With
 
 '===============================
zrkb:
'建总任课表

'Set xlzbook = xlApp.Workbooks.Add
Set xlzrksheet = xlzbook.Worksheets.Add
xlzrksheet.name = "总任课表"
'居中
xlzrksheet.Columns.HorizontalAlignment = xlCenter
xlzrksheet.Rows.VerticalAlignment = xlCenter
'列宽
For i = 1 To Day * Class + 1
xlzrksheet.Columns(i + 1).ColumnWidth = xlzrksheet.Columns(i + 1).ColumnWidth * 0.8
Next i
'行高

h = xlzrksheet.Rows(1).RowHeight
For i = 1 To bjs
xlzrksheet.Rows(i + 2).RowHeight = h * 2.2 ' xlzrksheet.Rows(i + 1).RowHeight * 2
Next i

'表头和格线

With xlzrksheet
'所有单元画细线
For i = 1 To bjs + 2
For j = 1 To Class * Day + 1
Cells(i, j).Borders.LineStyle = xlContinuous
Cells(i, j).Borders.Weight = xlThin
Next j
Next i


For j = 1 To Day

'首行合并
.Range(.Cells(1, Class * (j - 1) + 2), .Cells(1, Class * (j - 1) + 8)).Merge (True)
.Cells(1, Class * (j - 1) + 2).Value = Mid$("星期一星期二星期三星期四星期五星期六星期日", (j - 1) * 3 + 1, 3)
'粗行线
For i = 1 To Class + 1
.Cells(1, (j - 1) * Class + i).Borders(xlTop).LineStyle = xlContinuous
.Cells(1, (j - 1) * Class + i).Borders(xlTop).Weight = xlMedium

.Cells(2, (j - 1) * Class + i).Borders(xlTop).LineStyle = xlContinuous
.Cells(2, (j - 1) * Class + i).Borders(xlTop).Weight = xlMedium

.Cells(2, (j - 1) * Class + i).Borders(xlBottom).LineStyle = xlContinuous
.Cells(2, (j - 1) * Class + i).Borders(xlBottom).Weight = xlMedium
'未行
.Cells(bjs + 2, (j - 1) * Class + i).Borders(xlBottom).LineStyle = xlContinuous
.Cells(bjs + 2, (j - 1) * Class + i).Borders(xlBottom).Weight = xlMedium
Next i



'粗列线
For i = 1 To bjs + 2
Cells(i, Class * (j - 1) + 2).Borders(xlLeft).LineStyle = xlContinuous
Cells(i, Class * (j - 1) + 2).Borders(xlLeft).Weight = xlMedium
Next i

For i = 2 To bjs + 2
Cells(i, Class * (j - 1) + Class1 + 1).Borders(xlRight).LineStyle = xlContinuous
Cells(i, Class * (j - 1) + Class1 + 1).Borders(xlRight).Weight = xlMedium
Next i

Next j
'首列
For i = 1 To bjs + 2
Cells(i, 1).Borders(xlLeft).LineStyle = xlContinuous
Cells(i, 1).Borders(xlLeft).Weight = xlMedium

 '末列
Cells(i, Day * Class + 1).Borders(xlRight).LineStyle = xlContinuous
Cells(i, Day * Class + 1).Borders(xlRight).Weight = xlMedium
Next i

End With

For j = 1 To Day
For i = 1 To Class
'次行
xlzrksheet.Cells(2, (j - 1) * Class + i + 1).Value = i
Next i
Next j
'填总任课表内容教师和课程
xlzrksheet.Cells(1, 1) = "时间"
xlzrksheet.Cells(2, 1) = "班级"

For b = 1 To bjs
Get #12, b, newbiao
'首列班级名
strname = Left$(newbiao.bj, 2) + Mid$(newbiao.bj, 7, 2)
strname = Trim$(strname)
xlzrksheet.Cells(b + 2, 1).Value = strname
strname = Trim$(Left$(newbiao.bj, 8))
'课程
For i = 0 To Class - 1
For j = 0 To Day - 1
strcell = Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
strcell = Trim$(strcell)
If Trim$(strcell) = "x" Then strcell = " "
'get strjs姓名
strjs = ""
For js = 1 To zjss

If InStr(jskbs(js).rkbiao(i, j), strname) <> 0 And InStr(jskbs(js).rkbiao(i, j), strcell) <> 0 Then
strjs = Trim$(Left$(jskbs(js).js, 4))
Exit For
End If
Next js

xlzrksheet.Cells(b + 2, j * Class + i + 2).WrapText = True
xlzrksheet.Cells(b + 2, j * Class + i + 2) = strcell + "  " + strjs
Next j
Next i

Next b

Close #12
xlzbook.Worksheets("sheet1").Visible = False
xlzbook.Worksheets("sheet2").Visible = False
xlzbook.Worksheets("sheet3").Visible = False

'规定窗口及菜单样式
xlApp.Windows.Arrange arrangeStyle:=xlCascade
xlApp.Caption = "Excel--Pk10 总课表"
xlApp.CommandBars(4).Visible = False
xlApp.CommandBars(3).Visible = False
xlApp.CommandBars(1).Visible = True

Set xlzsheet = Nothing
Set xlzrksheet = Nothing
Set xlzshsheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Sub


Private Sub Command4_Click()
Unload Me
End Sub


Private Sub mnuback_Click()
Unload Me

End Sub