?? frmgrid.frm
字號:
VERSION 5.00
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmGridModify
BackColor = &H00C0C0C0&
BorderStyle = 3 'Fixed Dialog
Caption = "基本信息修改"
ClientHeight = 6540
ClientLeft = 45
ClientTop = 615
ClientWidth = 9510
Icon = "frmGrid.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6540
ScaleWidth = 9510
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin ComctlLib.StatusBar SBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 3
Top = 6165
Width = 9510
_ExtentX = 16775
_ExtentY = 661
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 2
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
TextSave = ""
Key = ""
Object.Tag = ""
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 14155
TextSave = ""
Key = ""
Object.Tag = ""
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin TabDlg.SSTab SSTab1
Height = 6060
Left = 30
TabIndex = 0
Top = 75
Width = 9435
_ExtentX = 16642
_ExtentY = 10689
_Version = 393216
Tabs = 2
TabsPerRow = 2
TabHeight = 882
BackColor = 12632256
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "幼圓"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TabCaption(0) = "學生基本信息全屏修改"
TabPicture(0) = "frmGrid.frx":044A
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "DBGrdstudent"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).ControlCount= 1
TabCaption(1) = "學生家庭信息全屏修改"
TabPicture(1) = "frmGrid.frx":0764
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "dbgrdFamily"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).ControlCount= 1
Begin VB.PictureBox DBGrdstudent
Height = 5295
Left = 90
ScaleHeight = 5235
ScaleWidth = 9165
TabIndex = 1
Top = 630
Width = 9225
End
Begin VB.PictureBox dbgrdFamily
Height = 5295
Left = -74910
ScaleHeight = 5235
ScaleWidth = 9165
TabIndex = 2
Top = 630
Width = 9225
End
End
Begin VB.Data Data2
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游標
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 1950
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 2460
Visible = 0 'False
Width = 1575
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游標
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 4290
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "ZBQKB"
Top = 4290
Visible = 0 'False
Width = 1455
End
Begin VB.Line Line1
BorderColor = &H00000000&
X1 = 30
X2 = 3090
Y1 = 30
Y2 = 30
End
Begin VB.Menu mnusys
Caption = "【文件&S】"
Begin VB.Menu mnusysexit
Caption = "退出[&X]"
End
End
Begin VB.Menu MNULOC
Caption = "【記錄定位&L】"
Begin VB.Menu MNUDW
Caption = "基本庫記錄定位[&D]"
End
Begin VB.Menu MNU21
Caption = "-"
End
Begin VB.Menu MNUDW2
Caption = "家長庫記錄定位[&F]"
End
End
Begin VB.Menu MNUQH
Caption = "【功能切換&C】"
Begin VB.Menu MNUQH1
Caption = "數據錄入[&A]"
End
Begin VB.Menu MNU31
Caption = "-"
End
Begin VB.Menu MNUQH2
Caption = "記錄查詢[&S]"
End
Begin VB.Menu MNU32
Caption = "-"
End
Begin VB.Menu MNUQH3
Caption = "數據統計[&C]"
End
End
Begin VB.Menu MNUFUZU
Caption = "【輔助功能&O】"
Begin VB.Menu MNUFUZU1
Caption = "允許成批修改[&A]"
End
End
Begin VB.Menu MNUHELP
Caption = "【幫助&H】"
Begin VB.Menu MNUNOTE
Caption = "使用說明[&N]"
End
End
End
Attribute VB_Name = "frmGridModify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim msSortCol As String
Dim mbCtrlKey As Integer
Private Sub dbgrdFamily_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意改變嗎!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdFamily_BeforeDelete(Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意刪除嗎!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdFamily_HeadClick(ByVal ColIndex As Integer)
If Data2.RecordsetType = vbRSTypeTable Then Exit Sub
If mbCtrlKey Then
msSortCol = Data2.Recordset(ColIndex).Name & " desc"
mbCtrlKey = 0
Else
msSortCol = Data2.Recordset(ColIndex).Name
End If
sort
msSortCol = gsNUL_STR
End Sub
Private Sub dbgrdStudent_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意改變嗎!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdStudent_BeforeDelete(Cancel As Integer)
On Error Resume Next
If MNUFUZU1.Checked = True Then Exit Sub
If MsgBox("您同意刪除嗎!", vbInformation + vbOKCancel, "警告") = vbOK Then
Cancel = 0
Else
Cancel = 1
End If
End Sub
Private Sub dbgrdStudent_HeadClick(ByVal ColIndex As Integer)
If Data1.RecordsetType = vbRSTypeTable Then Exit Sub
If mbCtrlKey Then
msSortCol = Data1.Recordset(ColIndex).Name & " desc"
mbCtrlKey = 0
Else
msSortCol = Data1.Recordset(ColIndex).Name
End If
cmdSort_Click
msSortCol = gsNUL_STR
End Sub
Private Sub Form_Activate()
SSTab1.Tab = 0
SSTab1.SetFocus
End Sub
Private Sub Form_Load()
On Error GoTo err
Dim sqlForModify As String
Dim recForModify As Recordset
sqlForModify = "select xh as 學號,xm as 姓名,csny as 出生年月,xb as 性別,mz as 民族,xl as 學歷,yx as 院系,bj as 班級,hksx as 戶口屬性,nj as 年級,sy as 生源,zzmm as 政治面貌,tc as 特長,sfzhm as 身份證號碼,ltkhm as 靈通卡號碼,ss as 宿舍,dh as 電話,zy as 專業 ,pyfs as 培養方式,BYZX AS 畢業中學 from zbqkb"
Set recForModify = Dbstudent.OpenRecordset(sqlForModify, dbOpenDynaset)
Set Data1.Recordset = recForModify
sqlForModify = "select xh as 學號,xm as 姓名,jzxm1 as 家長姓名1,gx1 as 關系1,dw1 as 單位地址,ym1 as 單位郵碼,dh1 as 單位電話 ,jzxm2 as 家長姓名2,gx2 as 關系2,dw2 as 家庭地址,ym2 as 家庭郵碼 ,dh2 as 家庭電話 from jtqkb "
Set recForModify = Dbstudent.OpenRecordset(sqlForModify, dbOpenDynaset)
Set Data2.Recordset = recForModify
SBar1.Panels(1).Text = "[學生基本信息庫]中共有" & Data1.Recordset.RecordCount & "條記錄!"
'Else
SBar1.Panels(2).Text = "[家庭情況信息庫]中共有" & Data2.Recordset.RecordCount & "條記錄!"
Exit Sub
err:
MsgBox err.Description
End Sub
Private Sub Form_Resize()
On Error Resume Next
Line1.X1 = 0
Line1.X2 = frmGridModify.Width
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub
Private Sub MNUDW_Click()
On Error Resume Next
FRMDW.Caption = "學生基本信息庫記錄定位"
FRMDW.Label1.Caption = "請您輸入定位學號："
FRMDW.Show 1
End Sub
Private Sub MNUDW2_Click()
On Error Resume Next
FRMDW.Label1.Caption = "請您輸入定位學號："
FRMDW.Caption = "家長信息庫記錄定位"
FRMDW.Show 1
End Sub
Private Sub MNUFUZU1_Click()
If MNUFUZU1.Checked = True Then
MNUFUZU1.Checked = False
Else
MNUFUZU1.Checked = True
End If
End Sub
Private Sub MNUNOTE_Click()
On Error Resume Next
Dim TTT As String
Dim X
TTT = App.Path + "\help\repair.txt"
X = Shell("Notepad " + TTT, 1)
Exit Sub
End Sub
Private Sub MNUQH1_Click()
On Error Resume Next
frmBaseInput.Show 1
End Sub
Private Sub MNUQH2_Click()
On Error Resume Next
frmQuery.Show 1
End Sub
Private Sub MNUQH3_Click()
On Error Resume Next
frmCount.Show 1
End Sub
Private Sub mnusysexit_Click()
On Error Resume Next
Me.Hide
Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
'If SSTab1.Tab = 0 Then
SBar1.Panels(1).Text = "[學生基本信息庫]中共有" & Data1.Recordset.RecordCount & "條記錄!"
'Else
SBar1.Panels(2).Text = "[家庭情況信息庫]中共有" & Data2.Recordset.RecordCount & "條記錄!"
'End If
End Sub
Private Sub cmdSort_Click()
On Error GoTo sorterr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim SortStr As String
Set recRecordset1 = Data1.Recordset 'copy the recordset
SortStr = msSortCol
recRecordset1.sort = SortStr
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
Set Data1.Recordset = recRecordset2
Screen.MousePointer = 0
Exit Sub
sorterr:
Screen.MousePointer = 0
On Error Resume Next
Exit Sub
End Sub
Private Sub sort()
On Error GoTo sorterr
Dim recRecordset1 As Recordset, recRecordset2 As Recordset
Dim SortStr As String
Set recRecordset1 = Data2.Recordset 'copy the recordset
SortStr = msSortCol
recRecordset1.sort = SortStr
Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
Set Data2.Recordset = recRecordset2
Screen.MousePointer = 0
Exit Sub
sorterr:
Screen.MousePointer = 0
On Error Resume Next
Exit Sub
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -