📄 frm部门维护.frm
字号:
VERSION 5.00
Begin VB.Form frm部门维护
BorderStyle = 3 'Fixed Dialog
Caption = "部门维护"
ClientHeight = 1440
ClientLeft = 1095
ClientTop = 330
ClientWidth = 3165
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1440
ScaleWidth = 3165
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox picButtons
Align = 2 'Align Bottom
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 660
Left = 0
ScaleHeight = 660
ScaleWidth = 3165
TabIndex = 2
Top = 435
Width = 3165
Begin VB.CommandButton cmdClose
Caption = "关闭(&C)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2070
TabIndex = 8
Top = 360
Width = 1095
End
Begin VB.CommandButton cmdCancel
Caption = "放弃(&Q)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1035
TabIndex = 7
Top = 360
Width = 1095
End
Begin VB.CommandButton cmdSave
Caption = "保存(&S)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 0
TabIndex = 6
Top = 360
Width = 1095
End
Begin VB.CommandButton cmdAdd
Caption = "添加(&A)"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 0
TabIndex = 5
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdEdit
Caption = "修改(&E)"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1035
TabIndex = 4
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdDelete
Caption = "删除(&D)"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 2070
TabIndex = 3
Top = 0
Width = 1095
End
End
Begin VB.Data datPrimaryRS
Align = 2 'Align Bottom
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = "select 部门 from bmk"
Top = 1095
Width = 3165
End
Begin VB.TextBox txtFields
DataField = "部门"
DataSource = "datPrimaryRS"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1380
MaxLength = 10
TabIndex = 1
Top = 7
Width = 1695
End
Begin VB.Label lblLabels
Caption = "部门:"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 90
TabIndex = 0
Top = 60
Width = 1215
End
End
Attribute VB_Name = "frm部门维护"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sq
Private Sub cmdCancel_Click()
datPrimaryRS.Recordset.CancelUpdate
cmdAdd.Enabled = True
If datPrimaryRS.Recordset.RecordCount > 0 Then
cmdEdit.Enabled = True
cmdDelete.Enabled = True
End If
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdClose.Enabled = True
txtFields.Enabled = False
End Sub
Private Sub cmdEdit_Click()
datPrimaryRS.Recordset.Edit
txtFields.Enabled = True
txtFields.SetFocus
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdClose.Enabled = False
End Sub
Private Sub cmdSave_Click()
datPrimaryRS.UpdateRecord
datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified
cmdAdd.Enabled = True
cmdEdit.Enabled = True
cmdDelete.Enabled = True
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdClose.Enabled = True
txtFields.Enabled = False
End Sub
Private Sub Form_Load()
frm部门维护.datPrimaryRS.DatabaseName = xtlj & "bzxx.mdb"
frm部门维护.datPrimaryRS.RecordSource = "select * from [bmk]"
frm部门维护.datPrimaryRS.Refresh
cmdAdd.Enabled = True
If datPrimaryRS.Recordset.RecordCount > 0 Then
cmdEdit.Enabled = True
cmdDelete.Enabled = True
End If
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdClose.Enabled = True
txtFields.Enabled = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End Sub
Private Sub datPrimaryRS_Error(DataErr As Integer, Response As Integer)
'错误处理程序代码置于此处
'想要忽略错误，注释掉下一行
'想要俘获它们，在此添加代码处理它们
MsgBox "Data error event hit err:" & Error$(DataErr)
Response = 0 '忽略错误
End Sub
Private Sub datPrimaryRS_Reposition()
Screen.MousePointer = vbDefault
On Error Resume Next
'为 dynasets 和快照显示当前记录位置
datPrimaryRS.Caption = "当前记录: " & (datPrimaryRS.Recordset.AbsolutePosition + 1)
End Sub
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'验证代码置于此处
'下列动作发生时该事件被调用
Dim bCancel As Boolean
Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select
If bCancel Then adStatus = adStatusCancel
End Sub
Private Sub cmdAdd_Click()
datPrimaryRS.Recordset.AddNew
txtFields.Enabled = True
txtFields.SetFocus
cmdAdd.Enabled = False
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdClose.Enabled = False
End Sub
Private Sub cmdDelete_Click()
yn = MsgBox("是否真的删除?", 36)
If yn = vbYes Then
With datPrimaryRS.Recordset
If Not .EOF Then
.Delete
.MoveNext
If .EOF And .RecordCount <> 0 Then .MoveLast
If .EOF And .RecordCount = 0 Then
.MoveFirst
cmdAdd.Enabled = True
cmdEdit.Enabled = False
cmdDelete.Enabled = False
cmdSave.Enabled = False
cmdCancel.Enabled = False
cmdClose.Enabled = True
End If
End If
End With
End If
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
datPrimaryRS.Refresh
datPrimaryRS.Recordset.Bookmark = sq
Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
Private Sub cmdClose_Click()
Screen.MousePointer = vbDefault
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -