VERSION 5.00
Begin VB.Form frmexcel 
   Caption         =   "導(dǎo)出 Excel 表"
   ClientHeight    =   4650
   ClientLeft      =   2790
   ClientTop       =   2040
   ClientWidth     =   5490
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4650
   ScaleWidth      =   5490
   Begin VB.CommandButton Command3 
      Caption         =   "總監(jiān)考表簿"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   645
      Left            =   2355
      TabIndex        =   2
      Top             =   3045
      Width           =   2625
   End
   Begin VB.CommandButton Command2 
      Caption         =   "教師監(jiān)考表簿"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   645
      Left            =   2340
      TabIndex        =   1
      Top             =   2010
      Width           =   2625
   End
   Begin VB.CommandButton Command1 
      Caption         =   "班級監(jiān)考表簿"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   645
      Left            =   2355
      TabIndex        =   0
      Top             =   885
      Width           =   2625
   End
   Begin VB.Menu mnuback 
      Caption         =   "返回"
   End
End
Attribute VB_Name = "frmexcel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim newbiao As bjkcbiao
Private Sub Command1_Click()
On Error Resume Next
Dim xlApp As excel.Application
Dim xlBook, xljsbook, xlzbook As excel.Workbook
Dim xlSheet, xljssheet, xlzsheet, xlzrksheet As excel.Worksheet

Dim bjs As Integer

Dim strcell, strname, strjs As String
Dim b, i, j As Integer

'啟動excel
Set xlApp = New excel.Application
xlApp.Visible = True
'GoTo js

'建班級工作簿xlbook
Set xlBook = xlApp.Workbooks.Add

For b = ksbjs To 1 Step -1
newbjitem = bjarr(b)
strname = Left$(newbjitem.njm, 2) + Left(newbjitem.bjh, 2) ' + "班"

'建班級sheet表
Set xlSheet = xlBook.Worksheets.Add
xlSheet.name = strname
xlSheet.Columns.ColumnWidth = xlSheet.Columns.ColumnWidth * 2 '1.25
xlSheet.Columns("a").ColumnWidth = xlSheet.Columns("a").ColumnWidth * 0.3
xlSheet.Columns("b").ColumnWidth = xlSheet.Columns("b").ColumnWidth * 1.2
xlSheet.Columns.HorizontalAlignment = xlCenter
'居中
xlSheet.Columns.HorizontalAlignment = xlCenter
xlSheet.Rows.VerticalAlignment = xlCenter

' 設(shè)定表頭和線

With xlSheet
'行高
For i = 2 To Class + 2
.Rows(i).RowHeight = TextHeight("語") * 4 'Rows(i).RowHeight * 2.5
Next i
.Rows(1).RowHeight = Rows(1).RowHeight * 2
'首列
For i = 1 To Class
.Cells(i + 2, 1).Value = i
.Cells(i + 2, 1).Borders.LineStyle = xlContinuous ' "xi xian kuang"
.Cells(i + 2, 1).Characters.Font.Size = 18
Next i
.Cells(2, 1).Value = "節(jié)"
.Cells(2, 1).Characters.Font.Size = 18

'次列
.Cells(2, 2).Value = "時  間"
.Cells(2, 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
.Cells(2, 2).Characters.Font.Size = 18
For i = 1 To Class
.Cells(i + 2, 2).Value = Trim$(Str$(Fix(sj1(2 * i - 1) / 60))) + ":" + Trim$(Str$(sj1(2 * i - 1) - Fix(sj1(2 * i - 1) / 60) * 60)) + "-" + Trim$(Str$(Fix(sj1(2 * i) / 60))) + ":" + Trim$(Str$(sj1(2 * i) - Fix(sj1(2 * i) / 60) * 60))
.Cells(i + 2, 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
.Cells(i + 2, 2).Characters.Font.Size = 14
Next i
'首行
For j = 1 To Day
.Cells(2, j + 2).Value = Mid$("試期一試期二試期三試期四試期五試期試星期日", (j - 1) * 3 + 1, 3)
.Cells(2, j + 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
.Cells(2, j + 2).Characters.Font.Size = 16
Next j
'格線
For i = 1 To Class
For j = 1 To Day
.Cells(i + 2, j + 2).Borders.LineStyle = xlContinuous
Next j
Next i

For i = 1 To Class + 1
.Cells(i + 1, 1).Borders(xlLeft).Weight = xlMedium
.Cells(i + 1, 2).Borders(xlRight).Weight = xlMedium
.Cells(i + 1, Day + 2).Borders(xlRight).Weight = xlMedium
Next i

For j = 1 To Day + 2
.Cells(2, j).Borders(xlTop).Weight = xlMedium
.Cells(2, j).Borders(xlBottom).Weight = xlMedium
.Cells(Class1 + 2, j).Borders(xlBottom).Weight = xlMedium
.Cells(Class + 2, j).Borders(xlBottom).Weight = xlMedium
Next j

End With
'填班級表
Dim strcell0 As String
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(bjarr(b).jsbiao1(i, j), 4) + Left(bjarr(b).jsbiao2(i, j), 4) + strcell0  ' & Mid$(newbiao.kcbiao(i, j), 2, 1)+strcell0
xlSheet.Cells(i + 3, j + 3) = strcell ' Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
xlSheet.Cells(i + 3, j + 3).Characters.Font.Size = 24
Next j
Next i
xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, Day + 2)).Merge (True)
xlSheet.Cells(1, 1).Value = strname + "班監(jiān)考表"
xlSheet.Cells(1, 1).Characters.Font.Size = 18

Next b

xlBook.Worksheets("sheet1").Visible = False
xlBook.Worksheets("sheet2").Visible = False
xlBook.Worksheets("sheet3").Visible = False
'規(guī)定窗口及菜單樣式
xlApp.Caption = "Excel--Pk10 班級表"
xlApp.Windows.Arrange arrangeStyle:=xlCascade
xlApp.CommandBars(4).Visible = False
xlApp.CommandBars(3).Visible = False
xlApp.CommandBars(1).Visible = True

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub


Private Sub Cmdopenxl_Click()
End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim xlApp As excel.Application
Dim xlBook, xljsbook, xlzbook As excel.Workbook
Dim xlSheet, xljssheet, xlzsheet, xlzrksheet As excel.Worksheet

Dim bjs, js, zjss As Integer
Dim strcell, strname, strjs As String
Dim b, i, j As Integer

js:
'建教師工作簿xljsbook
Set xlApp = New excel.Application
xlApp.Visible = True

Set xljsbook = xlApp.Workbooks.Add

'Open App.Path + "\jsshu.bin" For Binary As #2
'Get #2, 1, zjss ' szjs%  ' 不同名的教師數(shù)目
'Close #2
'zjss = szjs%

For b = 1 To 3 'jkjss
Set xljssheet = xljsbook.Worksheets.Add
xljssheet.name = Left$(jsarr(b).jsm, 6)
xljssheet.Columns.ColumnWidth = xljssheet.Columns.ColumnWidth * 1.3
xljssheet.Columns(1).ColumnWidth = xljssheet.Columns.ColumnWidth * 0.3
xljssheet.Columns.HorizontalAlignment = xlCenter

' 設(shè)定表頭和線

With xljssheet

'居中
.Columns.HorizontalAlignment = xlCenter
.Rows.VerticalAlignment = xlCenter

'行高
For i = 1 To Class + 1
.Rows(i).RowHeight = Rows(i).RowHeight * 1.3
Next i

'首列
For i = 1 To Class
.Cells(i + 1, 1).Value = i
.Cells(i + 1, 1).Borders.LineStyle = xlContinuous ' "xi xian kuang"
Next i
'次列
.Cells(1, 2).Value = "時  間"
.Cells(1, 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
For i = 1 To Class
.Cells(i + 1, 2).Value = Trim$(Str$(Fix(sj1(2 * i - 1) / 60))) + ":" + Trim$(Str$(sj1(2 * i - 1) - Fix(sj1(2 * i - 1) / 60) * 60)) + "-" + Trim$(Str$(Fix(sj1(2 * i) / 60))) + ":" + Trim$(Str$(sj1(2 * i) - Fix(sj1(2 * i) / 60) * 60))
.Cells(i + 1, 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
Next i
'首行
For j = 1 To Day
.Cells(1, j + 2).Value = Mid$("試期一試期二試期三試期四試期五試期六試期日", (j - 1) * 3 + 1, 3)
.Cells(1, j + 2).Borders.LineStyle = xlContinuous ' "xi xian kuang"
Next j
'格線
For i = 1 To Class
For j = 1 To Day
.Cells(i + 1, j + 2).Borders.LineStyle = xlContinuous
Next j
Next i

For i = 1 To Class + 1
.Cells(i, 1).Borders(xlLeft).Weight = xlMedium
.Cells(i, 2).Borders(xlRight).Weight = xlMedium
.Cells(i, Day + 2).Borders(xlRight).Weight = xlMedium
Next i

For j = 1 To Day + 2
.Cells(1, j).Borders(xlTop).Weight = xlMedium
.Cells(1, j).Borders(xlBottom).Weight = xlMedium
.Cells(Class1 + 1, j).Borders(xlBottom).Weight = xlMedium
.Cells(Class + 1, j).Borders(xlBottom).Weight = xlMedium
Next j

End With

'填教師表
For i = 0 To Class - 1
For j = 0 To Day - 1


strcell = Trim$(jsarr(b).jkbiao1(i, j)) 'Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
If strcell = "x" Then strcell = " "
'strcell = Left$(strcell, 2) + Mid$(strcell, 7, 5)
xljssheet.Cells(i + 2, j + 3) = strcell ' Left$(newbiao.kcbiao(i, j), 1) & Mid$(newbiao.kcbiao(i, j), 2, 1)
'End If
Next j
Next i

Next b
xljsbook.Worksheets("sheet1").Visible = False
xljsbook.Worksheets("sheet2").Visible = False
xljsbook.Worksheets("sheet3").Visible = False
'規(guī)定窗口及菜單樣式
xlApp.Caption = "Excel--Pk10 教師表"
xlApp.Windows.Arrange arrangeStyle:=xlCascade
xlApp.CommandBars(4).Visible = False
xlApp.CommandBars(3).Visible = False
xlApp.CommandBars(1).Visible = True

Set xljssheet = Nothing
Set xljsbook = Nothing
Set xlApp = Nothing

End Sub


Private Sub Command3_Click()

On Error Resume Next
Dim xlApp As excel.Application
Dim xlBook, xljsbook, xlzbook As excel.Workbook
Dim xlSheet, xljssheet, xlzsheet, xlzrksheet, xlzshsheet As excel.Worksheet

Dim bjs As Integer
Dim js  As Integer
Dim zjss As Integer
Dim strcell, strname, strjs As String
Dim b, i, j As Integer

'取總教師數(shù)
'Open App.Path + "\jsshu.bin" For Binary As #2
'Get #2, 1, zjss  ' 不同名的教師數(shù)目
'Close #2
zjss = jkjss 'szjs%

'取班級數(shù)
'Open App.Path + "\bjshu.bin" For Binary As #7
'Get #7, 1, bjs
'Close #7
bjs = ksbjs

'啟動excel
Set xlApp = New excel.Application
xlApp.Visible = True

'建總課表簿
Set xlzbook = xlApp.Workbooks.Add
'建總課程表
Set xlzsheet = xlzbook.Worksheets.Add
xlzsheet.name = "總監(jiān)考表"
'居中
xlzsheet.Columns.HorizontalAlignment = xlCenter
xlzsheet.Rows.VerticalAlignment = xlCenter
'列寬