SQLstr = "INSERT INTO NHB (學號,姓名,性別,分數,ID) VALUES('" & Text1(0).Text & "','" & Text2(0).Text & "','" & Text3(0).Text & "','" & Text4(0).Text & "','" & QaQAA & "');"
            dbs.Execute SQLstr
            dbs.Close
            DoEvents

            Set dbs = OpenDatabase(App.Path & "\TT.INI")
            SQLstr = "INSERT INTO NHB (學號,姓名,性別,分數,ID) VALUES('" & Text1(1).Text & "','" & Text2(1).Text & "','" & Text3(1).Text & "','" & Text4(1).Text & "','" & QaQAA & "');"
            dbs.Execute SQLstr
            dbs.Close

            WATING.PB.Value = QaQAA

            DoEvents
            Data1.Recordset.MoveNext
            DoEvents
            Data2.Recordset.MoveNext
            DoEvents
        Next QaQAA
        DoEvents


        ';*********************************************************************8
        Set dbs = OpenDatabase(App.Path & "\TT.INI")
        SQLstr = "DELETE FROM NHB WHERE 性別=''"
        dbs.Execute SQLstr
        dbs.Close

        WATING.Label2.Caption = "載入智能引擎"

        DoEvents

        If SM / 科目 - CByte(SM / 科目) > 0 Then
            SMA = CByte(SM / 科目) + 1
        Else
            SMA = CByte(SM / 科目)
        End If
        Me.Caption = "每班人數限制 (分數平衡)  設置每一班級" & 科目 & "人" & " " & "程序智能分配" & "" & SMA & "個班級"
        Dim AW As Long
        For AW = 1 To SMA
            Combo1.AddItem AW
        Next
        Combo1.ListIndex = 0


        Combo2.ListIndex = 1
        vp.Columns = Combo2.Text



        Data3.DatabaseName = App.Path & "\TT.INI"
        Data3.RecordSource = "select ID2,分數,班級,ID from NHB ORDER BY ID"
        Data3.Refresh
        Dim III As Long
        For III = 1 To VF.Rows - 1
            VF.TextMatrix(III, 0) = III
            VF.TextMatrix(III, 1) = III
            VF.TextMatrix(III, 3) = 1
        Next
        DoEvents



        Dim QaQ As Long
        For QaQ = 2 To SMA


            Data3.DatabaseName = App.Path & "\TT.INI"
            Data3.RecordSource = "select ID2,分數,班級,ID from NHB where ID2>" & 科目 & " ORDER BY ID"
            Data3.Refresh
            DoEvents
            Dim IIIAA As Long
            For IIIAA = 1 To VF.Rows - 1
                VF.TextMatrix(IIIAA, 1) = IIIAA
                VF.TextMatrix(IIIAA, 3) = QaQ


                DoEvents
                WATING.Label2.Caption = "正在智能分析  " & QaQ & "--" & IIIAA
                DoEvents
                WATING.PB.Value = 0
                DoEvents
                '                                WATING.PB.Value = QQ
                DoEvents
                WATING.PB1.Value = IIIAA
                DoEvents
            Next
        Next QaQ










        Call Combo1_Click
    End If
    Unload WATING

End Sub
Private Sub Command1_Click()
    On Error Resume Next
    '        Skin1.LoadSkin App.Path & "\SKIN\0.sk"
    '        Skin1.ApplySkinByName hwnd, "Form"
    ''        Skin1.ApplySkin Me.hwnd
    VF.Visible = False
    Toolbar2.Visible = False
    vp.Visible = True
    Toolbar1.Visible = True
End Sub
Private Sub Command2_Click()
    On Error Resume Next
    '        Skin1.LoadSkin App.Path & "\SKIN\3.sk"
    '        Skin1.ApplySkinByName hwnd, "Form"
    Skin1.ApplySkin Me.hwnd
    VF.Visible = True
    Toolbar2.Visible = True
    vp.Visible = False
    Toolbar1.Visible = False
End Sub
Private Sub Command4_Click()
    On Error Resume Next

    Unload Me
End Sub
Private Sub Form_Resize()
    On Error Resume Next

    VF.Width = Me.Width - 100
    VF.Height = Me.Height - Toolbar1.Height - 780
    VF.Top = Toolbar1.Height
    VF.Left = 0
    vp.Width = Me.Width - 150
    vp.Height = Me.Height - Toolbar2.Height - 400
    vp.Top = Toolbar2.Height
    vp.Left = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    MAIN.Enabled = True
    Unload sca
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset
    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
End Sub
Private Sub Print_Click()
    '開始打印
    On Error Resume Next
    If vp.PageCount > 0 Then vp.PrintDoc
End Sub
Private Sub scrlPage_Change()
    '操作 scrlpage 時同時對下面的當前頁顯示值進行控制
    On Error Resume Next
    scrlPage.SmallChange = vp.PreviewPages
    scrlPage.LargeChange = scrlPage.SmallChange
    vp.PreviewPage = scrlPage.Value
    Dim lp%
    lp = vp.PreviewPage + vp.PreviewPages - 1
    If lp > vp.PageCount Then lp = vp.PageCount
    If lp < vp.PreviewPage Then lp = vp.PreviewPage
    If lp > vp.PreviewPage Then
        lblPage = vp.PreviewPage & " - " & lp & " of " & vp.PageCount
    Else
        lblPage = vp.PreviewPage & " of " & vp.PageCount
    End If
    '操作 scrlpage 時同時對下面的當前頁顯示值進行控制
End Sub

Private Sub vp_EndPage()
    '得到總頁數,并且 scrlpage 自動適應其狀態
    On Error Resume Next
    scrlPage.Max = vp.PageCount
    scrlPage.Value = vp.PreviewPage
    scrlPage_Change
    DoEvents
    '得到總頁數,并且 scrlpage 自動適應其狀態
End Sub
Sub RenderRecordset(vp As VSPrinter, rs As Recordset, ByVal maxh As Double)
    On Error Resume Next
    Dim arr, i%, j%, wid!
    ' read recordset into an array
    rs.MoveLast
    rs.MoveFirst
    i = rs.RecordCount
    If i = 0 Then Exit Sub
    arr = rs.GetRows(i)
    ' create table header and dummy format
    Dim fmt$, hdr$
    For i = 0 To rs.Fields.Count - 1
        If i > 0 Then hdr = hdr & "|"
        fmt = fmt & "|"
        hdr = hdr & rs.Fields(i).Name
        fmt = fmt & 0
    Next
    ' create table
    vp.StartTable
    vp.AddTableArray fmt, hdr, arr
    ' format table
    For i = 0 To rs.Fields.Count - 1
        ' right-align numbers and dates
        Select Case rs.Fields(i).Type
            Case dbBigInt, dbByte, dbChar, dbCurrency, dbDecimal, dbDouble, dbFloat, dbInteger, dbLong, dbNumeric, dbSingle, dbDate
                vp.TableCell(tcColAlign, , i + 1) = taCenterMiddle
        End Select
        ' set column width
        If rs.Fields(i).Type = dbMemo Then
            vp.TableCell(tcColWidth, , i + 1) = "2.5in"
        Else
            fmt = ""
            For j = 0 To UBound(arr, 2)
                If j > 100 Then Exit For
                If Len(fmt) < Len(arr(i, j)) Then
                    fmt = arr(i, j)
                End If
            Next
            If Len(rs.Fields(i).Name) > Len(fmt) Then fmt = rs.Fields(i).Name
            '                        vp.TableCell(tcColWidth, , i + 1) = vp.TextWidth(fmt) * 13
            vp.TableCell(tcColWidth, , i + 1) = (vp.PageWidth - vp.MarginLeft - vp.MarginRight) / rs.Fields.Count
        End If
    Next
    ' format header row (0)
    vp.TableCell(tcFontBold, 0) = True '設置表關字體的粗細
    vp.TableCell(tcBackColor, 0) = vbYellow '設置表關字體的顏色
    vp.TableCell(tcRowHeight, 0) = vp.TextHeight("Test") * 2.5 '設置表關字體的高度
    vp.TableCell(tcAlign, 0) = taCenterMiddle '設置表格頭參數,字體居中
    '
    ' make sure it all fits
    For i = 1 To vp.TableCell(tcCols)
        wid = wid + vp.TableCell(tcColWidth, , i)  '設置左右參數
    Next
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    Dim ii As Long
    For ii = 1 To vp.TableCell(tcRows)
        vp.TableCell(tcAlign, ii) = taCenterMiddle   '設置表格內容居中顯示
    Next
    '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    vp.GetMargins
    If wid > vp.X2 - vp.X1 Then
        wid = (vp.X2 - vp.X1) / wid * 0.95
        For i = 1 To vp.TableCell(tcCols)
            vp.TableCell(tcColWidth, , i) = wid * vp.TableCell(tcColWidth, , i)
        Next
    End If
    ' honor maximum row height
    If maxh > 0 Then
        For i = 1 To vp.TableCell(tcRows)
            If vp.TableCell(tcRowHeight, i) > maxh Then
                vp.TableCell(tcRowHeight, i) = maxh
            End If
        Next
    End If
    ' done with table
    vp.EndTable
End Sub

Sub cmbSource()
    On Error Resume Next
    '打印代碼從此處載入
    '        On Error Resume Next
    MousePointer = vbHourglass
    Dim i%
    Data3.DatabaseName = App.Path & "\TT.INI"
    Data3.RecordSource = s
    Data3.Refresh
    Dim rs As Recordset
    Set rs = Data3.Recordset
    With vp
        .PenColor = RGB(0, 0, 255)
        .StartDoc

        nhb = GetProfile(App.Path & "\SET.ini", "學校", "校名")
        .Footer = "打印日期:" & Format(Date, "Long Date") & "||注:(此班級共有學生" & VF.Rows - 1 & "人)"
        .Header = nhb & vbCrLf & vbCrLf & "|" & nmc & "(" & Combo1.Text & ")班學生名單 (共" & SMA & "個班級)|當前頁 %d"
        RenderRecordset vp, rs, 0
        .EndDoc
        .ScrollIntoView 0, 0
    End With
    MousePointer = vbDefault
End Sub
Private Sub btnFont_Click()
    On Error Resume Next
    Me.Enabled = False
    '設置字體等項目
    With Me.vp
        CommonDialog1.Flags = cdlCFBoth + cdlCFEffects
        CommonDialog1.FontName = .FontName
        CommonDialog1.FontSize = .FontSize
        CommonDialog1.FontBold = .FontBold
        CommonDialog1.FontItalic = .FontItalic
        CommonDialog1.FontUnderline = .FontUnderline
        CommonDialog1.FontStrikethru = .FontStrikethru
        '                CommonDialog1.Color = .PenColor
        CommonDialog1.ShowFont
        .FontName = CommonDialog1.FontName
        .FontSize = CommonDialog1.FontSize
        .FontBold = CommonDialog1.FontBold
        .FontItalic = CommonDialog1.FontItalic
        .FontUnderline = CommonDialog1.FontUnderline
        .FontStrikethru = CommonDialog1.FontStrikethru
        .PenColor = CommonDialog1.Color
        .TextColor = CommonDialog1.Color
    End With
    DoEvents
    cmbSource
    Me.Enabled = True
End Sub
Private Sub SETHARD_Click()
    On Error Resume Next
    Me.Enabled = False
    With Me.vp
        CommonDialog2.Flags = cdlCFBoth + cdlCFEffects
        CommonDialog2.FontName = .HdrFontName
        CommonDialog2.FontSize = .HdrFontSize
        CommonDialog2.FontBold = .HdrFontBold
        CommonDialog2.FontItalic = .HdrFontItalic
        CommonDialog2.FontUnderline = .HdrFontUnderline
        CommonDialog2.FontStrikethru = .HdrFontStrikethru
        CommonDialog2.Color = .HdrColor
        CommonDialog2.ShowFont
        .HdrFontName = CommonDialog2.FontName
        .HdrFontSize = CommonDialog2.FontSize
        .HdrFontBold = CommonDialog2.FontBold
        .HdrFontItalic = CommonDialog2.FontItalic
        .HdrFontUnderline = CommonDialog2.FontUnderline
        .HdrFontStrikethru = CommonDialog2.FontStrikethru
        .HdrColor = CommonDialog2.Color
    End With
    DoEvents
    cmbSource
    Me.Enabled = True
End Sub
Private Sub cmdPageSetup_Click()
    '調出頁面設置界面
    On Error Resume Next
    Me.Enabled = False
    vp.PrintDialog pdPageSetup
    cmbSource
    Me.Enabled = True
End Sub
Private Sub cmbPercent_Click()
    '進行百分比操作
    On Error Resume Next
    vp.Zoom = Val(cmbPercent.List(cmbPercent.ListIndex))
End Sub
Private Sub cmbZoomMode_Click()
    '當選擇了自定義時,則自定義參數生效
    On Error Resume Next
    If cmbZoomMode.ListIndex = 0 Then
        cmbPercent_Click
        cmbPercent.Enabled = True
    Else
        cmbPercent.Enabled = False
        vp.ZoomMode = cmbZoomMode.ListIndex
    End If
End Sub