login10.frm

花图馆管理

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form login10 
   Caption         =   "Form1"
   ClientHeight    =   5235
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6450
   LinkTopic       =   "Form1"
   ScaleHeight     =   5235
   ScaleWidth      =   6450
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "导出学生成绩"
      Height          =   615
      Left            =   2040
      TabIndex        =   6
      Top             =   2760
      Width           =   1935
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   5160
      Top             =   1080
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command3 
      Caption         =   "取     消"
      Height          =   615
      Left            =   4200
      TabIndex        =   3
      Top             =   2760
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "导出学生信息"
      Height          =   615
      Left            =   120
      TabIndex        =   2
      Top             =   2760
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "...."
      Height          =   495
      Left            =   4320
      MaskColor       =   &H00FF80FF&
      TabIndex        =   1
      Top             =   1200
      Width           =   735
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   960
      TabIndex        =   0
      Top             =   1200
      Width           =   3375
   End
   Begin VB.Label Label2 
      Caption         =   "保存为"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   1200
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "导出学生的信息表和成绩表到EXCEL中"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   480
      TabIndex        =   4
      Top             =   240
      Width           =   5295
   End
End
Attribute VB_Name = "login10"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strFilepath As String
Private Sub Command1_Click()
   CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = "All Files (*.*)|*.*|Excel Files" & _
    "(*.xls)|*.xls"
    CommonDialog1.FilterIndex = 2
    CommonDialog1.ShowSave
    Text1.Text = CommonDialog1.FileName
    strFilepath = CommonDialog1.FileName                            '设置保存路径
    Exit Sub
ErrHandler:
    Exit Sub
End Sub

Private Sub Command2_Click()
    Dim i As Integer
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim oExcel As Object
    Dim oBook As Object
    Dim oSheet As Object
On Error GoTo Command1_Click_Error
    If Text1.Text = "" Then '判断输入
        MsgBox "请选择文件保存位置！", vbOKOnly + vbExclamation, "提示！"
    Else
        sql = "select * from students order by 学号"
        Set rs = TransactSQL(sql)
        If rs.EOF = False Then                                              '判断是否有统计记录
            Set oExcel = CreateObject("Excel.Application")
            Set oBook = oExcel.Workbooks.Add
            Set oSheet = oBook.Worksheets(1)
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1")
                 
            oSheet.Range("A1:L1").Select                                       '设置单元格
            With oExcel.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            
            oExcel.Selection.Merge                                            '设置标题
            oSheet.Range("A1:L1").Select
            oExcel.ActiveCell.FormulaR1C1 = "学生信息列表"
            
            With oExcel.ActiveCell.Characters(Start:=1, Length:=26).Font
                .name = "宋体"
                .FontStyle = "加粗"
                .Size = 18
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
            End With
            
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1") '设置表格
            
                oSheet.Cells(2, 1).Value = "学号"
                oSheet.Cells(2, 2).Value = "姓名"
                oSheet.Cells(2, 3).Value = "性别"
                oSheet.Cells(2, 4).Value = "年龄"
                oSheet.Cells(2, 5).Value = "入学时间"
                oSheet.Cells(2, 6).Value = "毕业时间"
                oSheet.Cells(2, 7).Value = "政治面貌"
                oSheet.Cells(2, 8).Value = "科别"
                oSheet.Cells(2, 9).Value = "籍贯"
                oSheet.Cells(2, 10).Value = "专业"
                oSheet.Columns("A:A").ColumnWidth = 8
                oSheet.Columns("B:B").ColumnWidth = 6
                oSheet.Columns("C:C").ColumnWidth = 4
                oSheet.Columns("D:D").ColumnWidth = 4
                oSheet.Columns("E:E").ColumnWidth = 8
                oSheet.Columns("F:F").ColumnWidth = 8
                oSheet.Columns("G:G").ColumnWidth = 4
                oSheet.Columns("H:H").ColumnWidth = 4
                oSheet.Columns("I:I").ColumnWidth = 8
                oSheet.Columns("J:J").ColumnWidth = 6
                rs.MoveFirst
                For i = 3 To rs.RecordCount + 2
                    oSheet.Cells(i, 1).Value = rs(0)
                    oSheet.Cells(i, 2).Value = rs(1)
                    oSheet.Cells(i, 3).Value = rs(2)
                    oSheet.Cells(i, 4).Value = rs(3)
                    oSheet.Cells(i, 5).Value = Format(rs(4), "yy-mm-dd")
                    oSheet.Cells(i, 6).Value = Format(rs(5), "yy-mm-dd")
                    oSheet.Cells(i, 7).Value = rs(6)
                    oSheet.Cells(i, 8).Value = rs(7)
                    oSheet.Cells(i, 9).Value = rs(8)
                    oSheet.Cells(i, 10).Value = rs(9)
                    rs.MoveNext
                Next i
                
            With oSheet                                                         '设置边框
                .Range(.Cells(1, 1), .Cells(rs.RecordCount + 2, 10)).Borders.LineStyle = xlContinuous
            End With
            
            oBook.SaveAs strFilepath                                            '保存文件
            
            If MsgBox("是否转到导出的Excel文件？", vbOKCancel) = vbOK Then
            Unload Me
            oExcel.Visible = True
            Else
            MsgBox "已经成功导出记录！", vbOKOnly + vbExclamation, "提示！"
            Unload Me
            End If
            Exit Sub
        Else
            MsgBox "数据库中没有记录！", vbOKOnly + vbExclamation, "提示！"
            Me.ZOrder 0
        End If
    End If
Command1_Click_Error:
    Exit Sub
End Sub

Private Sub Command3_Click()
Unload Me
Exit Sub
End Sub

Private Sub Command4_Click()
    Dim i As Integer
    Dim rs As New ADODB.Recordset
    Dim sql As String
    Dim oExcel As Object
    Dim oBook As Object
    Dim oSheet As Object
On Error GoTo Command1_Click_Error
    If Text1.Text = "" Then '判断输入
        MsgBox "请选择文件保存位置！", vbOKOnly + vbExclamation, "提示！"
    Else
        sql = "select * from chengji order by 学号"
        Set rs = TransactSQL(sql)
        If rs.EOF = False Then                                              '判断是否有统计记录
            Set oExcel = CreateObject("Excel.Application")
            Set oBook = oExcel.Workbooks.Add
            Set oSheet = oBook.Worksheets(1)
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1")
                 
            oSheet.Range("A1:E1").Select                                       '设置单元格
            With oExcel.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            
            oExcel.Selection.Merge                                            '设置标题
            oSheet.Range("A1:E1").Select
            oExcel.ActiveCell.FormulaR1C1 = "学生成绩信息列表"
            
            With oExcel.ActiveCell.Characters(Start:=1, Length:=26).Font
                .name = "宋体"
                .FontStyle = "加粗"
                .Size = 18
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
            End With
            
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1") '设置表格
            
                oSheet.Cells(2, 1).Value = "班级"
                oSheet.Cells(2, 2).Value = "学号"
                oSheet.Cells(2, 3).Value = "微机原理"
                oSheet.Cells(2, 4).Value = "c语言"
                oSheet.Cells(2, 5).Value = "网页设计"
             
                oSheet.Columns("A:A").ColumnWidth = 8
                oSheet.Columns("B:B").ColumnWidth = 6
                oSheet.Columns("C:C").ColumnWidth = 6
                oSheet.Columns("D:D").ColumnWidth = 6
                oSheet.Columns("E:E").ColumnWidth = 8
               
                rs.MoveFirst
                For i = 3 To rs.RecordCount + 2
                    oSheet.Cells(i, 1).Value = rs(0)
                    oSheet.Cells(i, 2).Value = rs(1)
                    oSheet.Cells(i, 3).Value = rs(2)
                    oSheet.Cells(i, 4).Value = rs(3)
                    oSheet.Cells(i, 5).Value = rs(4)
                 
                    rs.MoveNext
                Next i
                
            With oSheet                                                         '设置边框
                .Range(.Cells(1, 1), .Cells(rs.RecordCount + 2, 5)).Borders.LineStyle = xlContinuous
            End With
            
            oBook.SaveAs strFilepath                                            '保存文件
            
            If MsgBox("是否转到导出的Excel文件？", vbOKCancel) = vbOK Then
            Unload Me
            oExcel.Visible = True
            Else
            MsgBox "已经成功导出记录！", vbOKOnly + vbExclamation, "提示！"
            Unload Me
            End If
            Exit Sub
        Else
            MsgBox "数据库中没有记录！", vbOKOnly + vbExclamation, "提示！"
            Me.ZOrder 0
        End If
    End If
Command1_Click_Error:
    Exit Sub
End Sub

Private Sub Form_Load()
 Me.Text1.Text = ""
End Sub