Excel实战技巧63： 制作具有数据导航功能的用户窗体

Private Sub FillTextBoxes()
    Dim cTxtBx As Control
    Dim lFldNo As Long
   
    For Each cTxtBx In Me.Controls
        If cTxtBx.Tag Like "Field*"Then
            lFldNo = Mid(cTxtBx.Tag, 6)
            cTxtBx.Text = mADORs.Fields(lFldNo)
        End If
    Next cTxtBx
End Sub

Private Sub DisableButtons(ParamArray aBtnTags() As Variant)
    Dim i As Long
    Dim ctl As Control
   
    For Each ctl In Me.Controls
        ctl.Enabled = True
        For i = LBound(aBtnTags) To UBound(aBtnTags)
            If ctl.Tag = aBtnTags(i) Then
                ctl.Enabled = False
                Exit For
            End If
        Next i
    Next ctl
End Sub

Private Sub UserForm_Initialize()
    DimsConn As String
    Dim sSQL As String
    Dim sDbPath As String
    Dim sDbName As String
   
   '存储数据库的路径和名称
   '可以修改为你自已的路径和名称
    sDbPath ="C:\Users\Administrator\Documents\"
    sDbName = "Northwind"
   
   '存储连接字符串
    sConn = "DSN=MS Access Database;"
    sConn = sConn & "DBQ=" &sDbPath & "" & sDbName & ".mdb;"
    sConn = sConn & "DefaultDir="& sDbPath & ";"
    sConn = sConn &"DriverId=281;FIL=MS Access;MaxBuffersize=2048;PageTimeout=5;"
   
   '存储SQL语句
    sSQL = "SELECT 雇员.雇员ID,雇员.姓氏,"
    sSQL = sSQL & "雇员.名字,雇员.出生日期,雇员.雇用日期 "
    sSQL = sSQL & "FROM " &sDbPath & "" & sDbName & ".mdb" & ".雇员" '此处要注意如果路径中有空格则需添加单引号来引用
 
   
   '创建新的连接和记录集
    Set mADOCon = New ADODB.Connection
    Set mADORs = New ADODB.Recordset
    mADORs.CursorLocation = adUseClient
   
   '打开连接和记录集
    mADOCon.Open sConn
    mADORs.Open sSQL, mADOCon, adOpenDynamic
   
   '到第一条记录
    mADORs.MoveFirst
   
   '调用特定目的的过程
    FillTextBoxes
    DisableButtons "ButtonFirst","ButtonPrev"
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    mADORs.Close
    mADOCon.Close
   
    Set mADORs = Nothing
    Set mADOCon = Nothing
End Sub

Private Sub cmdFirst_Click()
    mADORs.MoveFirst
    FillTextBoxes
   
    DisableButtons "ButtonFirst","ButtonPrev"
End Sub
 
Private Sub cmdLast_Click()
    mADORs.MoveLast
    FillTextBoxes
   
    DisableButtons "ButtonLast","ButtonNext"
End Sub
 
Private Sub cmdNext_Click()
    mADORs.MoveNext
    FillTextBoxes
   
    If mADORs.AbsolutePosition =mADORs.RecordCount Then
        DisableButtons "ButtonLast","ButtonNext"
    Else
        DisableButtons
    End If
End Sub
 
Private Sub cmdPrev_Click()
    mADORs.MovePrevious
    FillTextBoxes
   
    If mADORs.AbsolutePosition = 1 Then
        DisableButtons "buttonFirst","ButtonPrev"
    Else
        DisableButtons
    End If
End Sub