If .EOF Then .MoveLast

  End With

  Exit Sub

DeleteErr:

  MsgBox Err.Description

End Sub

Private Sub cmdRefresh_Click()

  '只有多用户应用程序需要

  On Error GoTo RefreshErr

  datPrimaryRS.Refresh

  Exit Sub

RefreshErr:

  MsgBox Err.Description

End Sub

Private Sub cmdUpdate_Click()

  On Error GoTo UpdateErr

  datPrimaryRS.Recordset.UpdateBatch adAffectAll

  Exit Sub

UpdateErr:

  MsgBox Err.Description

End Sub

Private Sub cmdClose_Click()

 Form3.Show

 frm专业信息表.Hide

End Sub

6.6单位信息表界面

图6.6单位信息表界面图

Private Sub Form_Resize()

  On Error Resume Next

  '当窗体调整时会调整网格

  grdDataGrid.Height = Me.ScaleHeight - datPrimaryRS.Height - 30 - picButtons.Height

End Sub

Private Sub Form_Unload(Cancel As Integer)

  Screen.MousePointer = vbDefault

End Sub

Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)

  '错误处理程序代码置于此处

  '想要忽略错误，注释掉下一行

  '想要捕获它们，在此添加代码以处理它们

  MsgBox "Data error event hit err:" & Description

End Sub

Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

  '为这个 recordset 显示当前记录位置

  datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)

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()

  On Error GoTo AddErr

  datPrimaryRS.Recordset.MoveLast

  grdDataGrid.SetFocus

  SendKeys "{down}"

Exit Sub

AddErr:

  MsgBox Err.Description

End Sub

Private Sub cmdDelete_Click()

  On Error GoTo DeleteErr

  With datPrimaryRS.Recordset

    .Delete

    .MoveNext

    If .EOF Then .MoveLast

  End With

  Exit Sub

DeleteErr:

  MsgBox Err.Description

End Sub

Private Sub cmdRefresh_Click()

  '只有多用户应用程序需要

  On Error GoTo RefreshErr

  datPrimaryRS.Refresh

  Exit Sub

RefreshErr:

  MsgBox Err.Description

End Sub

Private Sub cmdUpdate_Click()

  On Error GoTo UpdateErr

  datPrimaryRS.Recordset.UpdateBatch adAffectAll

  Exit Sub

UpdateErr:

  MsgBox Err.Description

End Sub

Private Sub cmdClose_Click()

 Form3.Show

 frm单位信息表.Hide

End Sub

VB与Access数据库连接通过在模块中定义连接函数实现，具体代码如下：

Public cn As New ADODB.Connection

Public rs As New ADODB.Recordset

Public Function ConnectToServer() As Boolean

On Error GoTo ConnectErr

cn.Provider = "sqloledb"

   cn.Properties("data source").Value = "KJ-A96E6B514C66"

   cn.Properties("initial catalog").Value = "student"

   cn.Properties("Integrated Security").Value = "SSPI"

   cn.ConnectionTimeout = 30

   cn.Open

   ConnectToServer = True

   Exit Function

ConnectErr:

    ConnectToServer = False

    MsgBox "错误代码:" & Err.Number & vbCrLf & "错误描述:" & Err.Description, vbCritical + vbOKOnly, "连接错误"

End Function

Public Function DisConnect() As Boolean

    If cn.State = adStateOpen Then

       cn.Close

    End If

    DisConnect = True

End Function

Public Sub crs(ByVal strsql As String)

   On Error GoTo err1

   Set rs = Nothing

   rs.Open strsql, cn, adOpenDynamic, adLockOptimistic, -1

   Exit Sub

err1:

   MsgBox "错误信息:" & Err.Number & vbCrLf & _

         "错误描述:" & Err.Description, vbCritical

   Call DisConnect

   End

 End Sub

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]  ... 下一页  >>