infor.frm

我自己写的。缓和 我自己写的。缓和 我自己写的。缓和 我自己写的。缓和

VERSION 5.00
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form infor 
   Caption         =   "鹏羽信息管理系统       V1.1"
   ClientHeight    =   6630
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   10035
   LinkTopic       =   "Form1"
   ScaleHeight     =   6630
   ScaleWidth      =   10035
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame1 
      Caption         =   "学生基本信息表"
      Height          =   6375
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   10000
      Begin MSComDlg.CommonDialog CommonDialog1 
         Left            =   5160
         Top             =   5880
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         DefaultExt      =   "xls"
         DialogTitle     =   "请选择保存路径"
         Filter          =   "*.xls"
         InitDir         =   "d:\"
      End
      Begin StoneXP.XPButton edt 
         Height          =   350
         Left            =   1200
         TabIndex        =   2
         Top             =   5950
         Width           =   975
         _ExtentX        =   1720
         _ExtentY        =   609
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Caption         =   "修改数据"
         MouseIcon       =   "infor.frx":0000
         MousePointer    =   99
      End
      Begin FlexCell.Grid infor_table 
         Height          =   5415
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   9735
         _ExtentX        =   17171
         _ExtentY        =   9551
         Cols            =   5
         Rows            =   30
      End
      Begin VB.Label admin_admina 
         Caption         =   "Label1"
         Height          =   255
         Left            =   3480
         TabIndex        =   3
         Top             =   6000
         Width           =   975
      End
   End
   Begin VB.Menu files 
      Caption         =   "文件(&F)"
      Begin VB.Menu turnto_excel 
         Caption         =   "导出数据为Excel文档"
         Shortcut        =   ^T
      End
      Begin VB.Menu print 
         Caption         =   "打印(&P)"
         Shortcut        =   ^P
      End
   End
   Begin VB.Menu edit 
      Caption         =   "编辑(&E)"
   End
End
Attribute VB_Name = "infor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Public files_path As String


Private Sub edt_Click()
 Dim rs2 As ADODB.Recordset
 Dim Rs3 As ADODB.Recordset
 ExecuteSql Rs3, "select * from 学生信息"
   For i = 1 To infor_table.Rows - 1
     For j = 1 To 6
      ExecuteSql rs2, ("update 学生信息 set " & Rs3.Fields(j - 1).Name & "='" & infor_table.Cell(i, j).Text & "' where 学号='" & infor_table.Cell(i, 2).Text & "' ")
     Next
   Next
   MsgBox "修改保存数据成功"
  infor_table.Refresh
  rs2.Close
  Set rs2 = Nothing
  Rs3.Close
  Set Rs3 = Nothing
End Sub

Private Sub Form_Load()
 Call infor
 admin_admina.Caption = Admin_admin1
End Sub

Private Sub infor()
  Dim rs1 As ADODB.Recordset
  ExecuteSql rs1, "select * from 学生信息"
  infor_table.Cols = 7
   For j = 1 To 6
       infor_table.Cell(0, j).Text = rs1.Fields(j - 1).Name
   Next
   
   Do While Not rs1.EOF
   i = i + 1
      For k = 1 To 6
           If rs1.Fields(k - 1) <> "" Then
            infor_table.Cell(i, k).Text = rs1.Fields(k - 1)
            infor_table.Cell(i, 0).Text = i
           Else
            infor_table.Cell(i, k).Text = ""
           End If
      Next
   rs1.MoveNext
   Loop
   infor_table.Rows = i + 1
   rs1.Close
   Set rs1 = Nothing
End Sub

Private Sub infor_table_Click()
For j = 1 To infor_table.Rows - 1
    For i = 1 To 6
     If 1 = 1 Then
      infor_table.Range(j, 1, j, 6).BackColor = RGB(100, 200, 300)
     End If
  Next
Next
End Sub
'
'Private Sub infor_table_RowColChange(ByVal Row As Long, ByVal Col As Long)
' For j = 1 To infor_table.Rows - 1
'  If infor_table.Column(j).Selected Then
'    For i = 1 To 6
'      infor_table.Cell(j, i).BackColor = RGB(100, 200, 300)
'    Next
'  End If
'Next
'End Sub

Private Sub turnto_excel_Click()
  On Error GoTo cuowu2
  Dim Rs_excel As ADODB.Recordset
  ExecuteSql Rs_excel, "select * from 学生信息"  '打开数据表
  Dim j As Integer
 j = 1
  Dim myExcel As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
  Set myExcel = New Excel.Application

    myExcel.Visible = False
    myExcel.SheetsInNewWorkbook = 1
    Set xlBook = myExcel.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    xlSheet.Columns.ClearFormats
   For k = 1 To 6
    xlSheet.Cells(1, k) = Rs_excel.Fields(k - 1).Name  'Excel表格第一行的数据，即标题
   Next
Do While Not Rs_excel.EOF
j = j + 1
  For i = 1 To 6
   xlSheet.Cells(j, i) = Rs_excel.Fields(i - 1)   'Excel表格的内容
  Next

Rs_excel.MoveNext
Loop
  Rs_excel.Close  '关闭对象
  Set Rs_excel = Nothing '释放内存  该作用非常大，可以减少内存空间，提高软件运行速度，应该在每个对象不使用的时候关闭
   
        CommonDialog1.ShowSave  '显示选择路径对话框，其中showopen为打开，showsave为保存
            If CommonDialog1.FileName = "" Then
                myExcel.Quit
                Set myexecel = Nothing
               Exit Sub
            Else
    
               xlBook.SaveAs CommonDialog1.FileName '保存文件
               myExcel.Quit
    
             Set myExcel = Nothing '释放内存
            End If
  Exit Sub
cuowu2:
     MsgBox "操作已经取消"
     myExcel.Quit
      Set myExcel = Nothing '释放内存
End Sub