For j = 1 To Grid1.Cols - 1
            sql = sql & Grid1.Cell(i, j).Text & "','"
           Next
  sql = sql & XPCombo1.Text & "')"
  Set kc1 = cnn.Execute(sql)
     If Grid1.Cell(i, 8).Text <> "默認(rèn)" Then
    Set kc1 = cnn.Execute("select * from 公共教室 where 教室名稱='" & Grid1.Cell(i, 8).Text & "' and 所屬='" & Grid1.Cell(i, 1).Text & "'")
    If kc1.EOF = True Then
    Dim num As Integer
     num = 7 * nknumber
     sql = ""
     For n1 = 1 To num
     sql = sql & "0"
     Next
    Set kc1 = cnn.Execute("select 屬性 from 公共教室 where 教室名稱='" & Grid1.Cell(i, 8).Text & "' and 所屬='匯總'")
    Set kc2 = cnn.Execute("insert into 公共教室 values('" & Grid1.Cell(i, 8).Text & "','" & kc1.Fields(0) & "','" & sql & "','" & Grid1.Cell(i, 1).Text & "')")
   End If
  End If
  End If
Next
MsgBox "命令執(zhí)行完畢!", vbInformation, "完成"
Call XPButton3_Click
End Sub
Private Sub XPButton1_Click() '添加課程的按鈕
If XPCombo1.Text = "" Then
MsgBox "班級(jí)名稱不可為空，請(qǐng)選擇班級(jí)", vbInformation, "提示"
End If
word_validate
If vde = False Then
 MsgBox Msgboxstr1, vbInformation, "提示"
 Exit Sub
End If
Grid1.Visible = True
 kctable = "課程信息"
 numberkc = 8
 Set kc1 = cnn.Execute("select * from " & kctable)
 For i = 1 To numberkc
 Grid1.Cell(0, i).Text = kc1.Fields(i - 1).Name
 Next
 Grid1.Rows = 1
Grid1.Rows = 8
gridcenter
Grid1.Cell(1, 1).SetFocus
griddispose
kcsave = True
kcedit = False
kcdel = False
End Sub
Private Sub gridcenter()
If Grid1.Rows <> 1 Then '以下是將grid1的所有行所有列的文字全部居中顯示
Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).Alignment = cellCenterCenter
End If
End Sub
Private Sub griddispose() '這里主要是對(duì)課程的表格進(jìn)行處理,并加入課程分布以及所有課程名項(xiàng)
Grid1.Column(1).CellType = cellComboBox
Grid1.Column(5).CellType = cellComboBox
Grid1.Column(6).CellType = cellCheckBox
Grid1.Column(7).CellType = cellComboBox
Grid1.Column(8).CellType = cellComboBox
Grid1.ComboBox(1).Clear
Set kc2 = cnn.Execute("SELECT DISTINCT 課程名 FROM 課程名")
Do While Not kc2.EOF
Grid1.ComboBox(1).AddItem kc2.Fields(0)
kc2.MoveNext
Loop
Grid1.ComboBox(7).Clear
Grid1.ComboBox(7).AddItem "周一至周五"
Grid1.ComboBox(7).AddItem "周一至周六"
Grid1.ComboBox(7).AddItem "周一至周日"
Dim nnum As Integer
nnum = 7 * nknumber
For i = 1 To nnum
Grid1.ComboBox(7).AddItem "第" & i & "節(jié)課"
Next
Grid1.ComboBox(8).Clear
Grid1.ComboBox(8).AddItem "默認(rèn)"
Set kc2 = cnn.Execute("select DISTINCT 教室名稱 from 公共教室")
Do While Not kc2.EOF
Grid1.ComboBox(8).AddItem kc2.Fields(0)
kc2.MoveNext
Loop
End Sub

Private Sub XPButton2_Click() '這里是排課的主要代碼
'On Error GoTo finish
Dim x, y As Integer
Dim str1() As String
If XPCombo1.Text = "" Then
MsgBox "班級(jí)名稱不可為空，請(qǐng)選擇班級(jí)", vbInformation, "提示"
End If
Call XPButton3_Click
XPPbr1.Visible = True
'計(jì)算每周數(shù)目是否超出范圍
kbreturn '返回以前己生成的課表
Dim nnum As Integer '當(dāng)班級(jí)的課程為空時(shí)退出排課
Set kc2 = cnn.Execute("select count(所屬班級(jí)) from 課程信息 where 所屬班級(jí)='" & XPCombo1.Text & "'")
If kc2.Fields(0) = 0 Then
MsgBox "沒有定義課程，無法排課！", vbInformation, "課程未定義"
XPPbr1.Visible = False
Exit Sub
End If
'總結(jié)所有課程的每周課數(shù)累加是否超過規(guī)定的數(shù)量
Set kc1 = cnn.Execute("select sum(每周課數(shù)) from 課程信息 where 所屬班級(jí)='" & XPCombo1.Text & "'")
XPPbr1.Max = kc1.Fields(0)
XPPbr1.Min = 0
XPPbr1.Value = 0
nnum = 30
Set kc2 = cnn.Execute("select count(課程分布) from 課程信息 where 所屬班級(jí)='" & XPCombo1.Text & "' and 課程分布='周一至周六'")
nnum = nnum + kc2.Fields(0) * 2
Set kc2 = cnn.Execute("select count(課程分布) from 課程信息 where 所屬班級(jí)='" & XPCombo1.Text & "' and 課程分布='周一至周日'")
nnum = nnum + kc2.Fields(0) * 4
If kc1.Fields(0) > nnum Then
MsgBox "每周累計(jì)課數(shù)超出設(shè)置范圍，請(qǐng)重新調(diào)整"
Exit Sub
End If
Set kc2 = cnn.Execute("delete from 臨時(shí)生成表 where 所屬班級(jí)='" & XPCombo1.Text & "'")
'列出公共教室資源
Set kc1 = cnn.Execute("select * from 課程信息 where 所屬班級(jí)='" & XPCombo1.Text & "' and 教室選擇<>'默認(rèn)'")
If kc1.EOF = False Then
  Do While Not kc1.EOF
   Set kc2 = cnn.Execute("select * from 公共教室指定 where 教室名稱='" & kc1.Fields(7) & "' and 班級(jí)='" & kc1.Fields(8) & "' and 課程名='" & kc1.Fields(0) & "'")
   If kc2.EOF = True Then
    MsgBox "您定義的公共教室未進(jìn)行配置,請(qǐng)進(jìn)入公共教室配置中心", vbInformation, "任務(wù)未完成"
    XPPbr1.Visible = False
    Exit Sub
   End If
   kc1.MoveNext
  Loop
  kc1.MoveFirst
  Grid5.Range(1, 1, Grid5.Rows - 1, Grid5.Cols - 1).ClearText '先清除課程表表格中的所有內(nèi)容
  Do While Not kc1.EOF
    Set kc2 = cnn.Execute("select * from 公共教室指定 where 教室名稱='" & kc1.Fields(7) & "' and 班級(jí)='" & kc1.Fields(8) & "' and 課程名='" & kc1.Fields(0) & "'")
     str1 = Split(kc2.Fields(kc2.Fields.Count - 1), ",")
     For i = 0 To UBound(str1)
     x = Round(Int(str1(i)) / nknumber)
     If x < Int(str1(i)) / nknumber Then
     x = x + 1
     End If
     y = Int(str1(i)) Mod nknumber
     If y = 0 Then
      y = nknumber
     End If
     Grid5.Cell(y, x).Text = kc2.Fields(3)
     XPPbr1.Value = XPPbr1.Value + 1
     Next
     kc1.MoveNext
  Loop
End If
pkzx '進(jìn)入排課中心過程
XPPbr1.Visible = False
Exit Sub
'finish:
'MsgBox Err.Description
End Sub
Private Sub pkzx()
 'Second(Time)
'On Error GoTo finish
Dim weizi, x, y, j1, j2 As Integer
YuPK '冒泡排序空間法
Set kc4 = cnn.Execute("select * from 空間明細(xì) order by 剩余空間 asc")
Do While Not kc4.EOF
 For hang = 1 To Grid1.Rows - 1
  If Grid1.Cell(hang, 1).Text = kc4.Fields(0) Then
   Exit For
  End If
 Next
 If Grid1.Cell(hang, 8).Text = "默認(rèn)" Then
 Select Case Grid1.Cell(hang, 6).Text
  Case "1"
  n = 2 'n代表該課程是否允許連排
  Case "0"
  n = 1
  End Select
 gridcs '執(zhí)行過程,此過程主要是運(yùn)行數(shù)組比對(duì),讀取可用的教師資源和班級(jí)資源用
 grid4hq '這里是將可用的教師資源和班級(jí)資源進(jìn)行對(duì)比,得出需要的結(jié)果
   If Grid4.Rows <= 1 Then
   Set kc4 = cnn.Execute("delete * from 空間明細(xì)")
   MsgBox "本次生成課表時(shí)系統(tǒng)遇到不可預(yù)料故障,請(qǐng)檢查各項(xiàng)設(shè)定,并注銷課程表重新生成！"
   GoTo 1
   End If
 '通過比較得到較適當(dāng)?shù)恼n程位置
  Dim Gint(7) As Integer '存取當(dāng)前課程的各天空間
  Dim Statint(7) As Integer '存儲(chǔ)每一天首位值
  For i = 0 To 6
   Gint(i) = 0
   Statint(i) = 0
  Next
  Dim MXstr() As Integer '明細(xì)數(shù)組
  'MXstr = Split(kc4.Fields(2), ";")
  For i = 1 To Grid4.Rows - 1
    Dim MXInt As Integer
    MXInt = Round(Grid4.Cell(i, 1).Text / nknumber)
    If MXInt < Grid4.Cell(i, 1).Text / nknumber Then
      MXInt = MXInt + 1
    End If
    Select Case MXInt '獲昨每天的分布情況
    Case 1
         Gint(0) = Gint(0) + 1
         If Statint(0) = 0 Then
          Statint(0) = Grid4.Cell(i, 1).Text
         End If
    Case 2
         Gint(1) = Gint(1) + 1
         If Statint(1) = 0 Then
          Statint(1) = Grid4.Cell(i, 1).Text
         End If
    Case 3
         Gint(2) = Gint(2) + 1
         If Statint(2) = 0 Then
          Statint(2) = Grid4.Cell(i, 1).Text
         End If
    Case 4
         Gint(3) = Gint(3) + 1
         If Statint(3) = 0 Then
          Statint(3) = Grid4.Cell(i, 1).Text
         End If
    Case 5
         Gint(4) = Gint(4) + 1
         If Statint(4) = 0 Then
          Statint(4) = Grid4.Cell(i, 1).Text
         End If
    Case 6
         Gint(5) = Gint(5) + 1
         If Statint(5) = 0 Then
          Statint(5) = Grid4.Cell(i, 1).Text
         End If
    Case 7
         Gint(6) = Gint(6) + 1
         If Statint(6) = 0 Then
          Statint(6) = Grid4.Cell(i, 1).Text
         End If
    End Select
  Next
  '----------此段為將分布結(jié)果排序
  For i = 0 To 6
   Set kc5 = cnn.Execute("insert into i values(" & Gint(i) & "," & Statint(i) & ")")
  Next
   Set kc5 = cnn.Execute("select * from i order by i desc")
   For i = 0 To 6
     Gint(i) = kc5.Fields(0)
     Statint(i) = kc5.Fields(1)
     kc5.MoveNext
   Next
   Set kc5 = cnn.Execute("delete * from i")
'-----------
 '----------------------------
 
 
 '----------------------------
 For i = 1 To Grid1.Cell(hang, 3).Text / n '通過循環(huán)為某個(gè)課程開始排表
   weizi = Statint(i - 1) '等于最大值的列，相當(dāng)于平均分配
   '以下計(jì)算隨機(jī)出來的值,取向于課程有的某行某列
     x = Round(weizi / nknumber)
     If x < weizi / nknumber Then
     x = x + 1
     End If
     y = weizi Mod nknumber
     If y = 0 Then
      If nknumber <> 7 Then
      y = nknumber - 1
      Else
      y = nknumber
      End If
     End If
      Select Case n
       Case 2 '當(dāng)允許兩節(jié)課連排時(shí)運(yùn)行
          Grid5.Cell(y, x).Text = Grid1.Cell(hang, 1).Text
          Grid5.Cell(y + 1, x).Text = Grid1.Cell(hang, 1).Text
          array1(weizi) = "1"
          array1(weizi + 1) = "1"
          array2(weizi) = "1"
          array2(weizi + 1) = "1"
          XPPbr1.Value = XPPbr1.Value + 2
       Case 1
          Grid5.Cell(y, x).Text = Grid1.Cell(hang, 1).Text
          array1(weizi) = "1"
          array2(weizi) = "1"
          XPPbr1.Value = XPPbr1.Value + 1
       End Select
       '以上XX="1"的部分都是實(shí)時(shí)對(duì)表格進(jìn)行修改,以便后面將表格的數(shù)據(jù)提交到數(shù)據(jù)庫
        Dim gsql1, gsql2 As String
        gsql1 = ""
        gsql2 = ""
    For j1 = 1 To nknumber * 7 '以下是開始提交各表格的數(shù)據(jù)
     If array1(j1) = "" Then
     gsql1 = gsql1 & "0"
     Else
     gsql1 = gsql1 & array1(j1)
     End If
    Next
        Set kc2 = cnn.Execute("update 占用 set 占用='" & gsql1 & "' where 教師姓名='" & Grid1.Cell(hang, 5).Text & "'")
   '將修改的數(shù)據(jù)提交到數(shù)據(jù)庫中
   For j2 = 1 To nknumber * 7
     If array2(j2) = "" Then
       gsql2 = gsql2 & "0"
     Else
       gsql2 = gsql2 & array2(j2)
     End If
   Next
       Set kc2 = cnn.Execute("update 課程占用 set 占用='" & gsql2 & "' where 班級(jí)='" & XPCombo1.Text & "'")
  Next
  End If
 kc4.MoveNext
Loop
1:
Dim gsql3 As String
For i = 1 To Grid5.Rows - 1 '以下是將生成的課表保存到數(shù)據(jù)庫中
      gsql3 = "insert into 臨時(shí)生成表(時(shí)間段,星期一,星期二,星期三,星期四,星期五,星期六,星期日,所屬班級(jí)) values('"
            For j = 0 To Grid5.Cols - 1
            gsql3 = gsql3 & Grid5.Cell(i, j).Text & "','"
           Next
      gsql3 = gsql3 & XPCombo1.Text & "')"
  Set kc3 = cnn.Execute(gsql3)
Next
'添加教師對(duì)應(yīng)教學(xué)表
For i = 1 To Grid5.Rows - 1 '以下是將生成的課表保存到數(shù)據(jù)庫中
      gsql3 = "insert into 對(duì)應(yīng)教師表(時(shí)間段,一,二,三,四,五,六,日,班級(jí)) values('"
            gsql3 = gsql3 & Grid5.Cell(i, 0).Text & "','"
            For j = 1 To Grid5.Cols - 1
             For k = 0 To Grid1.Rows - 1
               If Grid5.Cell(i, j).Text = "" And k = Grid1.Rows - 1 Then
                gsql3 = gsql3 & "','"
               Else
               If Grid1.Cell(k, 1).Text = Grid5.Cell(i, j).Text Then
                 gsql3 = gsql3 & Grid1.Cell(k, 5).Text & "','"
               End If
               End If
             Next
           Next
      gsql3 = gsql3 & XPCombo1.Text & "')"
  Set kc3 = cnn.Execute(gsql3)

Next

Exit Sub
'finish:
'MsgBox Err.Description
End Sub

Private Sub XPButton3_Click()
On Error GoTo finish
If XPCombo1.Text = "" Then
MsgBox "班級(jí)名稱不可為空，請(qǐng)選擇班級(jí)", vbInformation, "提示"
End If
Grid1.Visible = True
kcsave = False
kcedit = True
kcdel = True
griddispose
kcmge
gridcenter
Exit Sub
finish:
MsgBox Err.Description
End Sub

Private Sub kbreturn() '此處主要是返回課表,解決課表占用情況
Call XPButton8_Click
Dim js As Integer
js = 0
XPPbr1.Max = (Grid5.Rows - 1) * (Grid5.Cols - 1)
XPPbr1.Min = 0
XPPbr1.Value = 0
For i = 1 To Grid5.Cols - 1
  For j = 1 To Grid5.Rows - 1
   js = js + 1
   XPPbr1.Value = XPPbr1.Value + 1
   If Grid5.Cell(j, i).Text <> "" Then
   Set kc1 = cnn.Execute("select 教室選擇 from 課程信息 where 課程名='" & Grid5.Cell(j, i).Text & "' and 所屬班級(jí)='" & XPCombo1.Text & "'")
   If kc1.Fields(0) = "默認(rèn)" Then '以下主要是通過得到教師的資源信息,通過循環(huán)得到所要返回的目標(biāo),然后對(duì)數(shù)據(jù)進(jìn)行修改
     Set kc2