frmzhxd.frm

成绩统计分析系统,可统计并分析学生的成绩。

         Caption         =   "BJ Like '20_' order by 总分 DESC"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000C0&
         Height          =   210
         Index           =   0
         Left            =   2520
         TabIndex        =   20
         Top             =   3480
         Visible         =   0   'False
         Width           =   3825
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "(2)请输入SQL导出语句"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   2760
         TabIndex        =   14
         Top             =   360
         Visible         =   0   'False
         Width           =   2595
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "(2)请选择需导出的数据表"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   2760
         TabIndex        =   13
         Top             =   360
         Visible         =   0   'False
         Width           =   2955
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "(1)请选择数据生成方式"
         BeginProperty Font 
            Name            =   "楷体_GB2312"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   240
         Left            =   2760
         TabIndex        =   12
         Top             =   360
         Width           =   2715
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "   此向导实现本系统任何数据向Excel数据格式的无缝转换！"
         Height          =   495
         Left            =   2880
         TabIndex        =   9
         Top             =   960
         Width           =   3405
      End
   End
   Begin MSComDlg.CommonDialog Cdlg 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "FrmZhxd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdFinish_Click()
On Error GoTo errs
    Dim ExcelApp As Excel.Application
    Dim ExcelBook As Excel.Workbook
    Dim ExcelSheet As Excel.Worksheet
If Label2.Visible = True Then
    Set ExcelApp = New Excel.Application
    ExcelApp.Visible = False
    Set ExcelBook = ExcelApp.Workbooks.Add
    Set ExcelSheet = ExcelBook.Worksheets.Item(1)
     If List1.ListIndex = -1 Then
        MsgBox "请选择输出数据表！", 16, "严重错误"
        Exit Sub
     End If
    rs.Open List1.Text, Con, , adLockPessimistic, adCmdTable
    RecordsetToExcel rs, ExcelSheet
    If OutTxt.Text = "" Then
      MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
      Exit Sub
    End If
    On Error GoTo ErrSave
     ExcelBook.Close True, OutTxt.Text
     MsgBox "输出成功！文件位于" & OutTxt.Text
     rs.Close
Else
    Set ExcelApp = New Excel.Application
    ExcelApp.Visible = False
    Set ExcelBook = ExcelApp.Workbooks.Add
    Set ExcelSheet = ExcelBook.Worksheets.Item(1)
     
    rs.Open SqlTxt.Text, Con, , adLockPessimistic, adCmdText
    RecordsetToExcel rs, ExcelSheet
    If OutTxt.Text = "" Then
      MsgBox "请指定输出文件位置和文件名！", 16, "严重错误"
      Exit Sub
    End If
    On Error GoTo ErrSave
     ExcelBook.Close True, OutTxt.Text
     MsgBox "输出成功！文件位于" & OutTxt.Text
     rs.Close
End If

Exit Sub
errs:
    MsgBox "Select 语句错误！", 16, "严重错误"
    ExcelBook.Close False
     Exit Sub
ErrSave:
    MsgBox "输出错误！", 16, "严重错误"
End Sub

'纪录导出到Execl
Public Sub RecordsetToExcel(rs As ADODB.Recordset, excel_sheet As Excel.Worksheet)
    Dim i As Long, j As Long
    Dim excel_range As Excel.Range
    Dim col_count As Long

    If rs.RecordCount = 0 Then
        Exit Sub
    End If

    Set excel_range = excel_sheet.Cells
    col_count = rs.Fields.Count
                
    For i = 0 To col_count - 1
        excel_sheet.Cells(1, i + 1).Value = rs.Fields(i).Name
    Next
    excel_sheet.Range(excel_sheet.Cells(1, 1), _
                      excel_sheet.Cells(1, col_count)).Font.Bold = True
        
    excel_sheet.Range("A2").CopyFromRecordset rs
            
End Sub

Private Sub cmdNext_Click()
If Option1.Value = True Then
    Label1.Visible = False
    Label2.Visible = True
    Frame1.Visible = False
    Frame2.Visible = True
    Frame3.Visible = True
    cmdNext.Visible = False
    cmdPrevious.Visible = True
    cmdFinish.Visible = True
    For i = 0 To 3
        LblS(i).Visible = False
    Next i
End If

If Option2.Value = True Then
    Label1.Visible = False
    Label3.Visible = True
    Frame1.Visible = False
    Frame3.Visible = True
    Frame4.Visible = True
    cmdNext.Visible = False
    cmdPrevious.Visible = True
    cmdFinish.Visible = True
    
    For i = 0 To 3
        LblS(i).Visible = True
    Next i
End If
End Sub

Private Sub cmdPrevious_Click()
    Label1.Visible = True
    Label2.Visible = False
    Label3.Visible = False
    Frame1.Visible = True
    Frame2.Visible = False
    Frame3.Visible = False
    Frame4.Visible = False
    cmdNext.Visible = True
    cmdPrevious.Visible = False
    cmdFinish.Visible = False
    For i = 0 To 3
        LblS(i).Visible = False
    Next i
End Sub

Private Sub Command2_Click()
Cdlg.DialogTitle = "另存为Excel文件："
Cdlg.Filter = "Excel文件|*.Xls|所有文件|*.*"
Cdlg.ShowSave
If Cdlg.FileName = "" Then Exit Sub
     OutTxt.Text = Cdlg.FileName
End Sub

Private Sub Form_Load()
    Set rs = New ADODB.Recordset
End Sub